VBA Looping cells and Copy based on criteria-CodePudding

[Copy A2 to E2 till the end of row of the table and check if the cell is within the same month](https://i.stack.imgur.com/Q7YAx.png)

Hi,

I would like to loop through rows from a sheet table from column A2 to E2 to A3 to E3... till the end of the table Ai to Ei by defining a variable and counting the last row of the table.

As the second step, I would like to copy the cells into another sheet and fill it the corresponding months.

[Desired Output--> it will copy the data and return to another sheet in the corresponding month] (https://i.stack.imgur.com/zhgYh.png)

Instead, I've changed the data type into a number format and have set up two condition to loop through.

eg. 1/1/2017 change to 42736

28/2/2017 change to 42794

Sub Mike_Copy_cell()

Dim i As Long 'for looping inside each cell
Dim myvalue As Variant
Dim Lastrow As Long
Const StartRow As Byte = 2
Dim LastMonth As Long

("Mike Filter").Select
Lastrow = Range("A" & StartRow).End(xlDown).Row
For i = StartRow To Lastrow
myvalue = Range("H" & i).Value
If myvalue \< Sheets("Automate Report").Range("A" & i).Value \_
'First data Feb Data 42794 \< Jan Category 42736
Then Sheets("Automate Report").Range("B" & i).Value = ""
'leave the cells in blanks and loop through next cell

        If myvalue > Sheets("Automate Report").Range("A" & i).Value _
       'First data Feb Data 42794 > Jan Category 42736 
            Then Range("A" & i, "E" & i).Copy Sheets("Automate Report").Range("B" & i, "F" & i)
       'Copy the cells into corresponding category 

Next i

End sub()

In my output, it is able to loop through and copy all the cells. However, I am wondering the reason why VBA output is not able leave any blank cells when the first condition is met ?

**I am expecting some blanks in the table if it is not data is not within the same month or in my case is less than criteria I have set. **

The output of my code

If myvalue < Sheets("Automate Report").Range("A" & i).Value _ Then Sheets("Automate Report").Range("B" & i).Value = ""

Greatly appreciate if you can advise the flaws in my code. Massive Thanks.

Best regards, Kenneth

CodePudding user response：

I'll try to help. But before, may I give you two suggestions that might help you?

First, for me the best way to find the last row is, instead of using xldown from the first row, using xlup from the very last row of excel. This way, if there is a blank in any middle row, the code still gives you the last row with value.

Second, I found that referring to any cells with the "range" method may limit you sometimes when using variables in this reference. I think using the "cells(row, column)" method is more useful.

Why not trying this?

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row

Sorry for the suggestions, It's just that I wish someone had taught them to me sooner.

Back to the topic, I think the problem is how you structure the "if" statement. Allow me to change it a bit:

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = StartRow To Lastrow
  myvalue = cells(i, 8).Value
  'if myvalue date is equal or previous to the one found in Ai...
  If myvalue <= Sheets("Automate Report").cells(i, 1).Value then
    Sheets("Automate Report").cells(i, 2).Value = ""
  'but if myvalue is later than Ai...
  else
    sheets("Automate Report").select
    range(cells(i, 1), cells(i, 5).select
    selection.copy
    cells(i, 2).select
    activesheet.paste
  end if
Next i

Hope this helps. Best regards,

Mike

CodePudding user response：

I'm not sure what your code is doing but consider using an array(12) of row numbers, one for each month. Copy lines into corresponding month and increment the row number for that month. For example ;

Option Explicit
Sub Mike_Copy_cell()

    Const LINES_MTH = 5 ' lines per month

    Dim wb As Workbook
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim lastrow As Long, rIn As Long, rOut(12) As Long
    Dim uid As String, prevuid As String
    Dim dAVD As Date, m As Long, n As Long
    
    Set wb = ThisWorkbook
    Set wsIn = wb.Sheets("Mike Filter")
    Set wsOut = wb.Sheets("Automate Report")
    
    ' space out months
    For n = 0 To 11
        rOut(n   1) = 2   n * LINES_MTH
        wsOut.Cells(rOut(n   1), "A").Value2 = MonthName(n   1)
    Next
  
    n = 0
    With wsIn
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For rIn = 2 To lastrow
        
            dAVD = .Cells(rIn, "D")
            ' create a unique ID to skip duplicates
            uid = .Cells(rIn, "A") & Format(.Cells(rIn, "D"), "YYYY-MM-DD")
            If uid <> prevuid Then
                m = Month(dAVD)
                .Cells(rIn, "A").Resize(, 5).Copy wsOut.Cells(rOut(m), "B")
                rOut(m) = rOut(m)   1
                n = n   1
            End If
            prevuid = uid
            
        Next
    End With
    MsgBox n & " lines copied to " & wsOut.Name, vbInformation

End Sub