Mr_Ragweed2
Board Regular
- Joined
- Nov 11, 2022
- Messages
- 145
- Office Version
- 365
- Platform
- Windows
Hello and thanks for reading this! (I apologize for length, but want to be thorough so you don't have to try and read my mind. Good question = good answer right?)
The code below works the first time through, but the code will be ran multiple times. It's a two step copy and paste based on other variables.
Below i have attached screenshots to show current and desired outcomes. I'm guessing the problem is in my "ThisFinal" (FinalRow) statement of the code.
When i have it set to ThisFinal = OSumWS.Cells(Rows.Count, 2).End(xlUp).Row it works great at looking at column B.
When i have it set to ThisFinal = OSumWS.Cells(Rows.Count, 17).End(xlUp).Row it works great at looking at Column Q.
It needs to look at both.
My code is at the bottom. - Don't laugh, i'm a novice who tries to adapt everything i see in the posts here.
Outcome on running it the first time:
Current outcome when i run it twice:
Desired outcome when i run it twice:
The code below works the first time through, but the code will be ran multiple times. It's a two step copy and paste based on other variables.
Below i have attached screenshots to show current and desired outcomes. I'm guessing the problem is in my "ThisFinal" (FinalRow) statement of the code.
When i have it set to ThisFinal = OSumWS.Cells(Rows.Count, 2).End(xlUp).Row it works great at looking at column B.
When i have it set to ThisFinal = OSumWS.Cells(Rows.Count, 17).End(xlUp).Row it works great at looking at Column Q.
It needs to look at both.
My code is at the bottom. - Don't laugh, i'm a novice who tries to adapt everything i see in the posts here.
Outcome on running it the first time:
Current outcome when i run it twice:
Desired outcome when i run it twice:
VBA Code:
Sheets("Dekalb Seed Order Form").Select
'does this find the next empty row? NO IT DOES NOT. It only looks for data in column B and does not account for column Q
' and when i set ThisFinal to 17 (Q) it does not account for column 2 (B)
Dim ThisFinal As Long
Dim i As Integer
Dim OSumWS As Worksheet
Dim DekalbWS As Worksheet
Set OSumWS = Sheets("Order Summary")
Set DekalbWS = Sheets("Dekalb Seed Order Form")
For i = 19 To 31
ThisFinal = OSumWS.Cells(Rows.Count, 2).End(xlUp).Row
If DekalbWS.Cells(i, 3).Value <> "" Then
With Application.Intersect(DekalbWS.Rows(i).EntireRow, DekalbWS.Range("C:U"))
.UnMerge
.Copy
End With
OSumWS.Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
OSumWS.UsedRange.Columns.AutoFit
Sheets("Dekalb Seed Order Form").Activate
'----------------------------------------------------------------------------------------
'below this line needs relocate to next available row after all product rows have been copied - works
Dim copyRange1 As Range
Dim copyRange2 As Range
Dim copyRange3 As Range
Dim copyRange4 As Range
Dim cel As Range
Dim pasteRange1 As Range
Dim pasteRange2 As Range
Dim pasteRange3 As Range
Dim pasteRange4 As Range
Dim FinalColumn As Long
Set copyRange1 = Sheets("Dekalb Seed Order Form").Range("T39")
Set copyRange2 = Sheets("Dekalb Seed Order Form").Range("T47")
Set copyRange3 = Sheets("Dekalb Seed Order Form").Range("T57")
Set copyRange4 = Sheets("Dekalb Seed Order Form").Range("N61")
Set pasteRange1 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
Set pasteRange2 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
Set pasteRange3 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
Set pasteRange4 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
For Each cel In copyRange1
cel.Copy
FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -6).Column
pasteRange1.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
For Each cel In copyRange2
cel.Copy
FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -5).Column
pasteRange2.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
For Each cel In copyRange3
cel.Copy
FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -4).Column
pasteRange3.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
For Each cel In copyRange4
cel.Copy
FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -3).Column
pasteRange4.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
Application.CutCopyMode = False
End If