Page 1 of 3 1 2 3 LastLast
Results 1 to 10 of 28

Thread: need to know data position

  1. #1

    need to know data position



    Register for a FREE account, and/
    or Log in to avoid these ads!

    hello everybody,

    In sheet1 I input the data in rows. I then select and copy a row (macro shortcut crtl+p) and go to sheet 2 where I paste the data (in column) (macro shortcut crtl+m). This all kinda work.

    In sheet 2 each column (range where I paste the data) has a name. I need this name to be visible in sheet1.

    Please see attached sample, where I have inserted (in sheet1) the desired result manually.

    thanks in advance for your help
    Attached Files Attached Files

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,418
    Articles
    0
    Excel Version
    365
    I'm working on this - could you paste the two macro codes you use to do the copying and the pasting?

  3. #3
    Here you go:

    Dim zWeight
    Dim zULD
    Dim zDest
    Dim zSpecials
    Dim zRow

    Sub copyData()

    zRow = ActiveCell.row 'e.g. 1

    '**************************************************************
    'DO NOT ALLOW HEADINGS ROW TO BE COPIED..
    '**************************************************************
    If zRow = 1 Then
    Beep
    Exit Sub
    End If
    '**************************************************************
    'TEST IF ALREADY COPIED..
    '**************************************************************
    zMarker = Range("G" & zRow).Value

    If zMarker = 1 Then
    saywhat = "This pallet has already been inserted!"
    saywhat = saywhat & vbCr & vbCr
    'saywhat = saywhat & "Check column [G]"
    saywhat = saywhat & vbCr & vbCr

    boxtitle = "Copy and Transpose process"
    btns = vbOKOnly + vbExclamation

    answer = MsgBox(saywhat, btns, boxtitle)

    Exit Sub
    End If

    '**************************************************************
    'CONTINUE WITH COPY PROCESS..
    '**************************************************************
    zWeight = Range("a" & zRow).Value
    zULD = Range("b" & zRow).Value
    zDest = Range("c" & zRow).Value
    zSpecials = Range("e" & zRow).Value
    Sheets("Loadplan").Select

    End Sub

    Sub transposeData()

    zSourceRow = zRow 'fetch saved value

    zRow = ActiveCell.row 'e.g. 1

    ActiveCell.Value = zULD
    ActiveCell.Offset(1) = zWeight
    ActiveCell.Offset(2) = zDest
    ActiveCell.Offset(3) = zSpecials

  4. #4
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,418
    Articles
    0
    Excel Version
    365
    1. Is there only an End Sub missing from the bottom of the last macro? Or is there more code?
    2. What code module(s) are these macros in?

    If you have put these macros in a standard code-module then try changing your transposeData macro to something along the lines of:
    Code:
    Sub transposeData()
    zSourceRow = zRow  'fetch saved value
    zRow = ActiveCell.Row  'e.g. 1
    
    ActiveCell.Value = zULD
    ActiveCell.Offset(1) = zWeight
    ActiveCell.Offset(2) = zDest
    ActiveCell.Offset(3) = zSpecials
    
    x = Array(4, 10, 16, 22, 31, 34, 40, 49)
    diff = 10000000000#
    For Each n In x
      If Abs(n - zRow) < diff Then
        diff = Abs(n - zRow)
        headerrow = n
      End If
    Next n
    If ActiveCell.Column = 21 And headerrow = 40 Then headerrow = 49
    Debug.Print headerrow
    Header = Cells(headerrow, ActiveCell.Column).Value
    With Sheets("Sheet1")  'adjust this if it isn't named "Sheet1".
      '  .Activate
      .Cells(zSourceRow, "F") = Header
      '.Cells(zSourceRow, "G") = 1 ' perhaps include this line?
    End With
    End Sub

  5. #5
    Hello there,

    1. there is more code that I use to eliminate the first 3 letters of zULD. This because of lack of space... this is the rest of the code:

    Selection.Replace What:="pmc", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Selection.Replace What:="pag", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Selection.Replace What:="paj", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Selection.Replace What:="pla", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Selection.Replace What:="ake", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Range("A1").Select
    Sheets("ULD").Select

    'PLACE MARKER IN SOURCE SHEET TO SAY TRANSPOSE HAS BEEN DONE..
    Sheets("ULD").Range("G" & zSourceRow).Value = 1


    End Sub

    Where you see "place Marker.." etc... this is what I am trying to eliminate with this thread.

    2. the code is in a Module

  6. #6
    p45cal, can I go ahead and ask a second question on the same sheets?

  7. #7
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,418
    Articles
    0
    Excel Version
    365
    Quite a lot of changes below, so don't try and make the changes to your own code, instead cut and paste the code to replace your code (you can keep your original code by commenting it all out).
    Code:
    Dim zWeight
    Dim zULD As String  'this has been changed!!!
    Dim zDest
    Dim zSpecials
    Dim zRow
    
    Sub copyData()
    zRow = ActiveCell.Row  'e.g. 1
    '**************************************************************
    'DO NOT ALLOW HEADINGS ROW TO BE COPIED..
    '**************************************************************
    If zRow = 1 Then
      Beep
      Exit Sub
    End If
    '**************************************************************
    'TEST IF ALREADY COPIED..
    '**************************************************************
    'zMarker = Range("G" & zRow).Value
    'If zMarker = 1 Then
    If Cells(zRow, "A").Interior.ThemeColor <> xlNone Then 'look for any shading in column A.
      saywhat = "This pallet has already been inserted!"
      saywhat = saywhat & vbCr & vbCr & vbCr & vbCr
      'saywhat = saywhat & "Check column [G]"
      boxtitle = "Copy and Transpose process"
      btns = vbOKOnly + vbExclamation
      answer = MsgBox(saywhat, btns, boxtitle)
      Exit Sub
    End If
    '**************************************************************
    'CONTINUE WITH COPY PROCESS..
    '**************************************************************
    zWeight = Range("a" & zRow).Value
    zULD = Range("b" & zRow).Value
    
    'Now to shorten zULD:
    'Either:
    'zULD = Mid(zULD, 4) 'to remove the first three characters regardless of what they are.
    'Or (to remove the 5 sets of characters if they are present):
    zz = Array("PLA", "AKE", "PAG", "PMC", "PAJ")
    For Each n In zz
      zULD = Replace(zULD, n, "", Compare:=vbTextCompare)
    Next n
    
    zDest = Range("c" & zRow).Value
    zSpecials = Range("e" & zRow).Value
    Sheets("Loadplan").Select
    End Sub
    
    Sub transposeData()
    zSourceRow = zRow  'fetch saved value
    zRow = ActiveCell.Row  'e.g. 1
    With ActiveCell
      .NumberFormat = "@" 'to format the cell as Text to preserve leading zeroes.
      .Value = zULD
      .Offset(1) = zWeight
      .Offset(2) = zDest
      .Offset(3) = zSpecials
    End With
    x = Array(4, 10, 16, 22, 31, 34, 40, 49)
    diff = 10000000000#
    For Each n In x
      If Abs(n - zRow) < diff Then
        diff = Abs(n - zRow)
        HeaderRow = n
      End If
    Next n
    If ActiveCell.Column = 21 And HeaderRow = 40 Then HeaderRow = 49
    Header = Cells(HeaderRow, ActiveCell.Column).Value
    Range("A1").Select 'because activecell is used above, you can't do this until now.
    With Sheets("ULD")  'adjust this if it isn't named "ULD".
      .Activate
      .Cells(zSourceRow, "F") = Header
      'PLACE MARKER IN SOURCE SHEET TO SAY TRANSPOSE HAS BEEN DONE..
      '.Cells(zSourceRow, "G") = 1
      'or remove the above line (and the conditional formatting in the sheet) and shade the cells with:
      With .Cells(zSourceRow, "A").Resize(, 5).Interior
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = -9.99786370433668E-02
      End With
    End With
    End Sub
    It does a few things (with alternatives in commented-out code).
    1. It shortens the zULD during the copying process (rather than the pasting process).
    2. There is an alternative commented-out snippet to remove the first 3 characters.
    3. When zULD is added to the active cell, the format of that cell is converted to "Text" to preserve leading zeroes.
    4. zULD is Dimmed as String in the code.
    5. The copy process uses shading in the cell in column A to determine if it's already been copied, instead of a 1 in column G.
    6. The pasting process also shades the first 5 columns in a given row on the ULD sheet and does not insert a 1 into column G. I'd advise removing conditional formatting from that sheet.



    re:
    Quote Originally Posted by s7y View Post
    2. the code is in a Module
    Yes, it has to be in a module, the question was what type of module: Standard code module, a sheet's code module, the Thisworkbook code module (or even a Class module!).



    Quote Originally Posted by s7y View Post
    p45cal, can I go ahead and ask a second question on the same sheets?
    Sure.

    It's bedtime here.

  8. #8
    the code works... but... when I clear Loadplan by using the following code:

    Sub ClearLoad()
    '
    ' ClearLoad Macro
    '
    Sheets("Loadplan").Select
    Range("B5:R8,B11:Q14,B17:S20,B23:U30,B35:U38,B41:H48,N41:S48,T45:T48,U40:U48").Select
    Selection.ClearContents
    Range("B13").Select
    Sheets("ULD").Select
    Range("f2:f42").Select
    Selection.ClearContents
    Range("A2").Select
    End Sub

    the shading in ULD remains and when I select the shaded uld the error message ("this pallet has already been inserted!") appears.

  9. #9
    also: I have tried to block some cells by using Data Validation. For example in Loadplan if data is present in cell B6 then no data is allowed in cells B12, B18, B24 and B28. If I input the data manually this works. if I use the ctrl+m then the validation is not working. is there a problem with the fact that after pasting the data in loadplan the next step is that the code opens ULD?

  10. #10
    I have edited the code to clear the loadplan as follows:

    Sub ClearLoad()
    '
    ' ClearLoad Macro
    '
    Sheets("Loadplan").Select
    Range("B5:R8,B11:Q14,B17:S20,B23:U30,B35:U38,B41:H48,N41:S48,T45:T48,U40:U48").Select
    Selection.ClearContents
    Range("B13").Select
    Sheets("ULD").Select
    Range("f2:f42").Select
    Selection.ClearContents
    Range("A2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("A2:F42").Select
    With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With
    ActiveWindow.SmallScroll Down:=-54
    Range("A2").Select

    End Sub

    and that solved the problem. now I can select the pallets.

Page 1 of 3 1 2 3 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •