VBA For Loop for multiple ranges not transferring properly

[Lil Stinker]

I stink at understanding VBA For Loops so maybe you can help me. I'm looking for a way to record/copy quantities on Sheet1: Column I, Rows 10:16 and Column Q, Rows 10:16 to Sheet2: Columns I:V, End xlUp.Row (next available row).
Below is what I have been trying to make work but the first thing that goes wrong is the data transfers to the wrong starting column on Sheet2. It should start in Column I but it drops the data into H instead. The second issue is dealing with the second column on Sheet1... I don't know enough to even know where to begin with that issue. So far, the existing For Loop transfers data just not to the right location. I tried adding another For Loop after the first to account for the second column's quantities but that just negated the first For Loop... and still copied the data into the wrong columns.

Sub RA_SaveRecord()

Dim raROW As Long, equipROW As Long

With Sheet1
If .Range("AB4").Value = True Then
    raROW = Sheet2.Range("A10001").End(xlUp).Row + 1
    .Range("Q4").Value = .Range("AB6").Value
    Sheet2.Range("B" & raROW).Value = .Range("Q4").Value
End If
For equipROW = 10 To 16
    Sheet2.Cells(raROW, equipROW - 2).Value = .Range("I" & equipROW).Value 'add quantities
Next equipROW
End With

End Sub

I'd appreciate any knowledge you can pass my way. If you need more specifics, please let me know.

 

[Alex Blakenburg]

Do you particularly want to do a loop ? If not something like this would work.

Sub RA_SaveRecord()

Dim raROWNext As Long
Dim rngToCopy As Range

With Sheet1
    If .Range("AB4").Value = True Then
        raROWNext = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("Q4").Value = .Range("AB6").Value
        Sheet2.Range("B" & raROWNext).Value = .Range("Q4").Value
        
        ' First Column
        Set rngToCopy = .Range("I10:I16")
        Sheet2.Range("I" & raROWNext).Resize(1, rngToCopy.Rows.Count).Value2 = Application.Transpose(rngToCopy)
        ' Second Column
        Set rngToCopy = .Range("Q10:Q16")
        Sheet2.Range("P" & raROWNext).Resize(1, rngToCopy.Rows.Count).Value2 = Application.Transpose(rngToCopy)
        
        
    End If
End With

End Sub

 

[Lil Stinker]

Do you particularly want to do a loop ? If not something like this would work.

Sub RA_SaveRecord()

Dim raROWNext As Long
Dim rngToCopy As Range

With Sheet1
    If .Range("AB4").Value = True Then
        raROWNext = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("Q4").Value = .Range("AB6").Value
        Sheet2.Range("B" & raROWNext).Value = .Range("Q4").Value
       
        ' First Column
        Set rngToCopy = .Range("I10:I16")
        Sheet2.Range("I" & raROWNext).Resize(1, rngToCopy.Rows.Count).Value2 = Application.Transpose(rngToCopy)
        ' Second Column
        Set rngToCopy = .Range("Q10:Q16")
        Sheet2.Range("P" & raROWNext).Resize(1, rngToCopy.Rows.Count).Value2 = Application.Transpose(rngToCopy)
       
       
    End If
End With

End Sub

Oh, that's interesting! I'm not familiar with this method. I'm completely green when it comes to VBA. Is Application.Transpose even compatible with Excel 2019 because I don't see it coming up as an option when I type in the code?

So, further down on this form, I have a little bit larger data set ranging from B24:O38 (215 cells), P24:Q38 (30 cells) and R24:S38 (30 cells), 18 columns, 15 rows, 3 different groups. This set copies to a separate sheet except on here the values transfer equally to 18 columns across and 15 rows at a time. Would you use this type of code here again or would a For Loop work better in this instance?

 

[Alex Blakenburg]

Is Application.Transpose even compatible with Excel 2019 because I don't see it coming up as an option when I type in the code?

Sorry I tend to default not using the WorksheetFunction command since the other method can make error handling easier in some instances.
To get vba intellisense (the help when you type in code), use the format WorksheetFunction.Transpose.
Tranpose does have some limits such a 65,536 rows and 255 characters in a cell.

I will work through your other example and get back to you.

 

[Alex Blakenburg]

I have had a look and it doesn't sound like you are transposing the data in your 2nd example (ie you are not changing the orientation).
Can you confirm ?
If you want to give me the sheet name and target address for each I can give you some code, it will be similar to the above without the transpose and you will most likely resize both the rows and columns.

 

[Lil Stinker]

I have had a look and it doesn't sound like you are transposing the data in your 2nd example (ie you are not changing the orientation).
Can you confirm ?
If you want to give me the sheet name and target address for each I can give you some code, it will be similar to the above without the transpose and you will most likely resize both the rows and columns.

Correct. The data would not be transposed on Sheet3.
The data set on Sheet1 is B24:O38 for Main Stuff, P24:Q38 for Other Stuff and R24:S38 for Things.
For Sheet3, Main Stuff copies to Columns C:P, Other Stuff to Q:R and Things to S:T.
I do have code for this that works. More than anything, I'm curious what alternative you come up with.

However, more importantly, back to the original question, once the data is stored on Sheet2 Columns I:V, how can I call it back to Sheet1 to the same set of cells in Column I10:I16 & Q10:Q16? Do I use the same code you provided and simply change out the ranges? Sheet1 is a form for users to input data which is then stored to records on Sheet 2 and 3. If they need to make any changes to existing forms, I need the data to load back to Sheet1 when they enter the corresponding ID#.

 

[Alex Blakenburg]

Its a bit difficult to give you specific code without specific detail.

how can I call it back to Sheet1 to the same set of cells in Column I10:I16 & Q10:Q16? Do I use the same code you provided and simply change out the ranges? Sheet1 is a form for users to input data which is then stored to records on Sheet 2 and 3. If they need to make any changes to existing forms, I need the data to load back to Sheet1 when they enter the corresponding ID#.

The copy back might look something like this but it relies on there being data in Column A down to the last row and that the data to copy back is still on that last row.

Sub CopyInTheReverseDirection()
' Copy the transposed data back in the reverse direction
Dim raRowLast
With Sheet2
    raRowLast = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    Sheet1.Range("I10:I16").Value = WorksheetFunction.Transpose(.Range(.Cells(raRowLast, "I"), .Cells(raRowLast, "O")))
    Sheet1.Range("Q10:Q16").Value = WorksheetFunction.Transpose(.Range(.Cells(raRowLast, "P"), .Cells(raRowLast, "V")))
End With
End Sub

Correct. The data would not be transposed on Sheet3.
The data set on Sheet1 is B24:O38 for Main Stuff, P24:Q38 for Other Stuff and R24:S38 for Things.
For Sheet3, Main Stuff copies to Columns C:P, Other Stuff to Q:R and Things to S:T.
I do have code for this that works. More than anything, I'm curious what alternative you come up with.

I assume you are in reality copying it to different sheets or rows because otherwise you would copy it in a single block.
Assuming your are just copying it side by side it would look something like this.

        ' The next 3 no transpose
        Set rngToCopy = .Range("B24:O38")
        Sheet2.Range("C" & raROWNext).Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Value2 = rngToCopy.Value2

        Set rngToCopy = .Range("P24:Q38 ")
        Sheet2.Range("Q" & raROWNext).Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Value2 = rngToCopy.Value2

        Set rngToCopy = .Range("R24:S38")
        Sheet2.Range("S" & raROWNext).Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Value2 = rngToCopy.Value2

 

[Lil Stinker]

Sub CopyInTheReverseDirection()
' Copy the transposed data back in the reverse direction
Dim raRowLast
With Sheet2
    raRowLast = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    Sheet1.Range("I10:I16").Value = WorksheetFunction.Transpose(.Range(.Cells(raRowLast, "I"), .Cells(raRowLast, "O")))
    Sheet1.Range("Q10:Q16").Value = WorksheetFunction.Transpose(.Range(.Cells(raRowLast, "P"), .Cells(raRowLast, "V")))
End With
End Sub

This isn't working for me when loading the data back to the original Sheet. No errors, just no data loading up.

Below is the full procedure I have used for set ups similar to this. Difference with those other forms was the data being stored and loaded went row by row. This form introduced a column by column element. I thought about using the same row by row method here again but I figured there has to be an easier way. Your transpose method works for transferring the data from Sheet1 to the Record sheet however, not in reverse. I assumed Dim raRowLast should be Long?

Sub RA_Load()
    Dim lastraITEMROW As Long, resultROW As Long, lastitemRESULTROW As Long, lastraRECROW As Long
    
    With Sheet1
        raROW = .Range("AB3").Value 'ra row id
        lastraRECROW = Sheet2.Range("A" & .Rows.Count).End(xlUp).Row 'last ra record row
                
        '''load details'''
        .Range("C8").Value = Sheet2.Range("E" & raROW).Value 'project
        .Range("AB5").Value = True 'set ra load to true
        .Range("AB4").Value = False 'set new ra to false
        .Range("P5").Value = Sheet2.Range("C" & raROW).Value 'opened by
        .Range("P6").Value = Sheet2.Range("D" & raROW).Value 'open date
        .Range("P7").Value = Sheet2.Range("F" & raROW).Value 'pay terms2
        .Range("B12").Value = Sheet2.Range("G" & raROW).Value 'pickup date
        .Range("B15").Value = Sheet2.Range("H" & raROW).Value 'return date
        .Range("C19").Value = Sheet2.Range("W" & raROW).Value 'notes
        .Range("I11:I13").Value = Application.Transpose(.Range(.Cells(lastraRECROW, "I"), .Cells(lastraRECROW, "K")))
        .Range("Q10:Q16").Value = Application.Transpose(.Range(.Cells(lastraRECROW, "L"), .Cells(lastraRECROW, "R")))
        
        'load in serials
        lastraITEMROW = Sheet3.Range("A1048576").End(xlUp).Row 'last item row
            If lastraITEMROW < 3 Then GoTo NoSerials
            Sheet3.Range("A2:V" & lastraITEMROW).AdvancedFilter xlFilterCopy, CriteriaRange:=Sheet3.Range("X1:X2"), CopyToRange:= _
                Sheet3.Range("Z2:AU2"), Unique:=False
        lastitemRESULTROW = Sheet3.Range("Z1048576").End(xlUp).Row
            If lastitemRESULTROW < 3 Then GoTo NoSerials
                For resultROW = 3 To lastitemRESULTROW
                    raITEMROW = Sheet3.Range("AT" & resultROW).Value 'quote result row
                    .Range("B" & raITEMROW & ":S" & raITEMROW).Value = Sheet3.Range("AB" & resultROW & ":AS" & resultROW).Value 'copy item serials
                    .Range("V" & raITEMROW).Value = Sheet3.Range("AU" & resultROW).Value 'copy result item row
                Next resultROW

NoSerials:
        .Range("AB5").Value = False 'set ra load to false

    End With
    End Sub

I changed some of the names to protect the innocent and shortened the range from your example after realizing if data loaded back to Sheet1 from Sheet2, it would wipe out formulas established in those cells on Sheet1. So now the Range in Col I is I11:I13. While Col Q remains the same.

'load in serials section
This is what I've used to pull in details from Sheet3 where the data is stored across Cols A:V. I use AdvancedFilter to copy based on the criteria (X1:X2) only the data pertaining to the necessary RA # (stored in Cols A:B). Results copy to Cols Z2:AU2. Those results should then be loaded into the corresponding cells on Sheet1 however, something here is not working either. For reasons I can't see, the serial numbers in the serial record (Sheet3) are not fully populating in the AdvancedFilter therefore, not loading correctly onto Sheet1. Yet this method has worked for me in the past on other forms.

Rather than get the full data set (Range C3:T17) copying over, I'm only getting the first column of each section so C3:C17, Q3:Q17 and S3:S17. Since you certainly know more about VBA, maybe you can see where things are going wrong. I'm only as versed as the tutorials I pick up on the web.

 

[Alex Blakenburg]

I am not on a computer at the moment.
Try changing the last row line from A to I

raRowLast = Sheet2.Range("I" & Rows.Count).End(xlUp).Row

 

[Lil Stinker]

Still nothing