Forum Discussion

Copper Contributor

Sep 08, 2020

VBA code to count, copy, paste, last row, if

Good evening I have only trained myself in excel VBA and have been able to learn very much from other peoples questions. I need a code to copy the data in image 1 (Sheet1) to the table in image 2 (...

Sep 08, 2020

Try this macro:

Sub CopyData()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim r1 As Long, r2 As Long
    Dim m1 As Long, m2 As Long, m3 As Long, n As Long
    Application.ScreenUpdating = False
    Set wsh1 = Worksheets("Sheet1")
    Set wsh2 = Worksheets("Sheet2")
    m1 = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row
    m2 = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row
    m3 = wsh1.Range("C" & wsh1.Rows.Count).End(xlUp).Row
    n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1
    For r1 = 2 To m1
        For r2 = 2 To m2
            wsh2.Range("A" & n).Resize(m3 - 1).Value = wsh1.Range("A" & r1).Value
            wsh2.Range("B" & n).Resize(m3 - 1).Value = wsh1.Range("B" & r2).Value
            wsh2.Range("C" & n).Resize(m3 - 1, 3).Value = wsh1.Range("C2:E" & m3).Value
            n = n + m3 - 1
        Next r2
    Next r1
    Application.ScreenUpdating = True
End Sub

Kettie

Copper Contributor

HansVogelaar

Good Afternoon Hans

Thank you very much for all the help. The previous codes all did exactly what I asked. I did however simplify the question (for privacy reasons) with the hope of modifying it to the model where I need it, but I am stuck. I am attaching another workbook with the exact layout that I am working on. Would you please help me again?

Set wsh1 = Worksheets("Spray instruction PL")

Set wsh2 = Worksheets("Records.")

Count the amount of cells used in wsh1 F16:F25
Copy the counted (in step 1) amount of cells in wsh 1 and paste in in last row +1 wsh2:

Copy wsh1 column:	Paste wsh2 column:
F	D
G	E
H	F
"='Spray instruction PL'!L16*IF(OR('Spray instruction PL'!N16=""KG"",'Spray instruction PL'!N16=""L""),1000,1)/10"	G
O	I
R	L
T	O
U	A

Also copy and paste the value of the following cells in wsh2

Copy wsh1 cells:	Paste wsh2 column:
$M$11	M
"=TEXTJOIN("" ,"",TRUE,K8,K7,K6)"	N
"=TEXTJOIN("" ,"",TRUE,G8,G7,G6)"	Q
$F$5	V
$O$8	X
$P$8	Y

The data in step 2 and 3 should be repeated for every used cell found in wsh1 B16:B25

Columns in wsh1 with cells that needs to repeat with every counted row:	Paste wsh2 column:
B16:B25	B
C16:C25	C
D16:D25	W
E16:E25	U

I look forward to your answer.

Kind regards

Record development.xlsm118 KB

HansVogelaar

MVP

Sep 14, 2020

Kettie

Hi Kettie,

I think this will do it, but please test thoroughly:

Sub CopyToRecords()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim r1 As Long, r2 As Long
    Dim m1 As Long, m2 As Long, n As Long
    Application.ScreenUpdating = False
    Set wsh1 = Worksheets("Spray instruction PL")
    Set wsh2 = Worksheets("Records.")
    m1 = wsh1.Range("B26").End(xlUp).Row
    m2 = wsh1.Range("F26").End(xlUp).Row - 15
    n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1
     For r1 = 16 To m1
        For r2 = 16 To m2 + 15
            ' Based on column B
            wsh2.Range("B" & n).Resize(m2).Value = wsh1.Range("B" & r1).Value
            wsh2.Range("C" & n).Resize(m2).Value = wsh1.Range("C" & r1).Value
            wsh2.Range("W" & n).Resize(m2).Value = wsh1.Range("D" & r1).Value
            wsh2.Range("U" & n).Resize(m2).Value = wsh1.Range("E" & r1).Value
            ' Based on coluumn F
            wsh2.Range("D" & n).Resize(m2).Value = wsh1.Range("F" & r2).Value
            wsh2.Range("E" & n).Resize(m2).Value = wsh1.Range("G" & r2).Value
            wsh2.Range("F" & n).Resize(m2).Value = wsh1.Range("H" & r2).Value
            With wsh2.Range("G" & n).Resize(m2)
                .Formula = "='Spray instruction PL'!L16*" & _
                    "IF(OR('Spray instruction PL'!N16={""KG"",""L""}),1000,1)"
                .Value = .Value
            End With
            wsh2.Range("I" & n).Resize(m2).Value = wsh1.Range("O" & r2).Value
            wsh2.Range("L" & n).Resize(m2).Value = wsh1.Range("R" & r2).Value
            wsh2.Range("O" & n).Resize(m2).Value = wsh1.Range("T" & r2).Value
            wsh2.Range("A" & n).Resize(m2).Value = wsh1.Range("U" & r2).Value
            ' Based on fixed cells
            wsh2.Range("M" & n).Resize(m2).Value = wsh1.Range("M11").Value
            With wsh2.Range("N" & n).Resize(m2)
                .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$K$8," & _
                    "'Spray instruction PL'!$K$7,'Spray instruction PL'!$K$6)"
                .Value = .Value
            End With
            With wsh2.Range("Q" & n).Resize(m2)
                .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$G$8," & _
                    "'Spray instruction PL'!$G$7,'Spray instruction PL'!$G$6)"
                .Value = .Value
            End With
            wsh2.Range("V" & n).Resize(m2).Value = wsh1.Range("F5").Value
            wsh2.Range("X" & n).Resize(m2).Value = wsh1.Range("O8").Value
            wsh2.Range("Y" & n).Resize(m2).Value = wsh1.Range("P8").Value
            n = n + m2
        Next r2
    Next r1
    Application.ScreenUpdating = True
End Sub

Kettie

Copper Contributor

Sep 15, 2020

Good afternoon HansVogelaar

Thank you for the swift response. It is almost there.

There is one thing that you can change for me please. I attached the doc. after I ran the code. There is three lines added for every one that is needed(From the 27 rows the code added, row number 11,15,19;20,24,28;29,33,37 are the exact data I need.). I think instead of trying to explain, I'm going to ask you to have a look at the columns that I highlighted in orange. The red text are data that I posted manually. It is only 9 lines. The code gives 27 lines. Also note that the order of the entries in the green column is not corresponding to the correct info in WSH 2 Column D to F

There was one "/10" that I already added to the IF formula.

Thank you so much for all the help.

Kind regards

Record development.xlsm125 KB

HansVogelaar

MVP

Sep 15, 2020

Kettie

My apologies, I misunderstood what you wanted. Try this version:

Sub CopyToRecords()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim r1 As Long, r2 As Long
    Dim m1 As Long, m2 As Long
    Dim n2 As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set wsh1 = Worksheets("Spray instruction PL")
    Set wsh2 = Worksheets("Records.")
    m1 = wsh1.Range("A26").End(xlUp).Row
    m2 = wsh1.Range("F26").End(xlUp).Row
    n2 = m2 - 15
    n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1
    For r1 = 16 To m1
        For r2 = 16 To m2
                wsh2.Range("A" & n).Resize(n2).Value = wsh1.Range("U" & r2).Value
                wsh2.Range("B" & n).Resize(n2).Value = wsh1.Range("B" & r2).Value
                wsh2.Range("C" & n).Resize(n2).Value = wsh1.Range("C" & r2).Value
                wsh2.Range("D" & n).Resize(n2).Value = wsh1.Range("F" & r1).Resize(n2).Value
                wsh2.Range("E" & n).Resize(n2).Value = wsh1.Range("G" & r1).Resize(n2).Value
                wsh2.Range("F" & n).Resize(n2).Value = wsh1.Range("H" & r1).Resize(n2).Value
                With wsh2.Range("G" & n).Resize(n2)
                    .Formula = "='Spray instruction PL'!L16*" & _
                        "IF(OR('Spray instruction PL'!N16={""KG"",""L""}),1000,1)/10"
                    .Value = .Value
                End With
                wsh2.Range("I" & n).Resize(n2).Value = wsh1.Range("O" & r1).Resize(n2).Value
                wsh2.Range("L" & n).Resize(n2).Value = wsh1.Range("R" & r1).Resize(n2).Value
                wsh2.Range("M" & n).Resize(n2).Value = wsh1.Range("M11").Value
                With wsh2.Range("N" & n).Resize(n2)
                    .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$K$8," & _
                        "'Spray instruction PL'!$K$7,'Spray instruction PL'!$K$6)"
                    .Value = .Value
                End With
                wsh2.Range("O" & n).Resize(n2).Value = wsh1.Range("T" & r2).Value
                With wsh2.Range("Q" & n).Resize(n2)
                    .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$G$8," & _
                        "'Spray instruction PL'!$G$7,'Spray instruction PL'!$G$6)"
                    .Value = .Value
                End With
                wsh2.Range("U" & n).Resize(n2).Value = wsh1.Range("E" & r2).Value
                wsh2.Range("V" & n).Resize(n2).Value = wsh1.Range("F5").Value
                wsh2.Range("W" & n).Resize(n2).Value = wsh1.Range("D" & r2).Value
                wsh2.Range("X" & n).Resize(n2).Value = wsh1.Range("O8").Value
                wsh2.Range("Y" & n).Resize(n2).Value = wsh1.Range("P8").Value
                n = n + n2
        Next r2
    Next r1
    Application.ScreenUpdating = True
End Sub

Kettie
Copper Contributor
Sep 21, 2020
Thanks again HansVogelaar. I am very close now. Everything goes to the correct place, but I got stuck again. The process gets repeated with the amout of what seems to be the count of column b * count of column f * count of column f (6*4*4=96 entries) only 24 is needed. The entries in red are needed, the rest in black are duplicates.

Please advise
Record development.xlsm128 KB