VBA If statement to continue

[dinunan]

Hi All,

I've a trading journal in one of the sheets. Entries are based on strategies like AT, SS, SELF etc in one of the column. Now I have separate sheets as well for AT, SS, SELF etc. End of the day I want to segregate my trades in separate sheets as per strategy. I've written the code for eg fetch the entries associated with AT in its dedicated sheet. If statement works as long as it finds AT but doesn't continue to next line if it finds anything else (other than AT). I want code to continue till last entry in the main sheet.

My code is attached below. Any help is appreciated.

Regards.
Dinesh.

Sub CopyTradesFromAT()

Dim rng As Range
Dim row As Range

Sheets("ATPA").Activate
Range("A408").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

Sheets("Trade Diary").Select
   Range(Selection, Selection.End(xlDown)).Select
   Range(Selection, Selection.End(xlToRight)).Select
   
   Set rng = Selection

For Each row In rng.Rows

    If ActiveCell.Offset(0, 4).Value = " " Then Exit Sub
 
    If ActiveCell.Offset(0, 4).Value = "AT" Then
        ActiveCell.Range("A1:B1").Select
        Selection.Copy
       
        Worksheets("ATPA").Activate
        ActiveCell.Activate
       Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       ActiveCell.Offset(0, 3).Activate
       
        Worksheets("Trade Diary").Activate
        Application.CutCopyMode = False
        ActiveCell.Range("H1:J1").Select
        Selection.Copy
   
        Worksheets("ATPA").Activate
        ActiveCell.Activate
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       ActiveCell.Offset(0, 3).Activate
       
        Worksheets("Trade Diary").Activate
        Application.CutCopyMode = False
        ActiveCell.Offset(0, 13).Range("A1").Select
        Selection.Copy
   
        Worksheets("ATPA").Activate
        ActiveCell.Activate
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       ActiveCell.Offset(1, -6).Activate
       
        Worksheets("Trade Diary").Activate
        Application.CutCopyMode = False
        ActiveCell.Offset(1, -20).Range("A1").Select

End If

Next row
   

    Worksheets("ATPA").Activate
End Sub

 

[mumps]

I have a busy schedule today so I will get back to you tomorrow.

 

[mumps]

Click here for your file. Please note a few changes I made to make it easier to program. By clicking the "Update" button on the Trade Diary sheet, the macro will prompt you to enter the uppercase three letter abbreviation for the month you want to process. It will work properly only if you select the last month entered in column A which in this case is "AUG". If you want to be able to select any month, the macro will have to be modified. Also, the name of the sheet "ATPA" will now be just "AT". Hopefully that will work for you. You will notice the array in the code below (in red) contains all the names of the sheets to be created when needed. You can add additional names to the array as needed. The macro is in Module1. I have created a blank "Template" sheet which is used to create the new sheets. Please don't modify it or delete it. Give it a try.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim lRow As Long, lRow2 As Long, mon As Range, sMon As String, v As Variant, i As Long, srcWS As Worksheet, cnt As Long
    v = Array("SS", "AT", "SELF", "ZLSMA")
    Set srcWS = Sheets("Trade Diary")
    lRow = srcWS.Range("F" & srcWS.Rows.Count).End(xlUp).row
    sMon = InputBox("Please enter the three letter abbreviation of the desired month name.")
    If sMon = "" Then Exit Sub
    If Len(sMon) <> 3 Then
        MsgBox ("Please use the three letter abbreviation of the desired month name and try again.")
        Exit Sub
    End If
    Set mon = srcWS.Range("A:A").Find(sMon, LookIn:=xlValues, lookat:=xlWhole)
    If Not mon Is Nothing Then
        For i = LBound(v) To UBound(v)
            If WorksheetFunction.CountIf(srcWS.Range("F" & mon.row & ":F" & lRow), v(i)) > 0 Then
                srcWS.Range("A" & mon.row - 1 & ":AK" & lRow).AutoFilter Field:=6, Criteria1:=v(i)
                cnt = srcWS.Range("A" & mon.row & ":A" & lRow).SpecialCells(xlCellTypeVisible).Cells.Count
                If Not Evaluate("isref('" & v(i) & "'!A1)") Then
                    Sheets("Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = v(i)
                    With ActiveSheet
                        lRow2 = .Range("F" & .Rows.Count).End(xlUp).row + 1
                        .Range("A" & lRow2).EntireRow.Resize(cnt).Insert
                        .Range("H" & lRow2).Resize(cnt).Formula = "=D" & lRow2 & "*(G" & lRow2 & "-F" & lRow2 & ")"
                        Intersect(srcWS.Rows(mon.row & ":" & lRow), srcWS.Range("B:C,G:G,I:K,V:V")).SpecialCells(xlVisible).Copy
                        .Range("A" & lRow2).PasteSpecial xlPasteValues
                        lRow2 = .Range("H" & .Rows.Count).End(xlUp).row + 1
                        .Range("H" & lRow2).Formula = "=sum(H3:H" & lRow2 - 1 & ")"
                    End With
                Else
                    With Sheets(v(i))
                        lRow2 = .Range("F" & .Rows.Count).End(xlUp).row + 1
                        .Range("A" & lRow2).EntireRow.Resize(cnt).Insert
                        .Range("H" & lRow2).Resize(cnt).Formula = "=D" & lRow2 & "*(G" & lRow2 & "-F" & lRow2 & ")"
                        Intersect(srcWS.Rows(mon.row & ":" & lRow), srcWS.Range("B:C,G:G,I:K,V:V")).SpecialCells(xlVisible).Copy
                        .Range("A" & lRow2).PasteSpecial xlPasteValues
                        lRow2 = .Range("H" & .Rows.Count).End(xlUp).row + 1
                        .Range("H" & lRow2).Formula = "=sum(H3:H" & lRow2 - 1 & ")"
                    End With
                End If
            End If
        Next i
    End If
    srcWS.Range("A" & mon.row - 1).AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[dinunan]

I've downloaded the file and now trying to understand how it works. Never seen such a professional coding. I will revert soon.

 

[dinunan]

Thank you so much mumps for the code, it works great and as intended.
There is one issue on the last line where AutoFilter is there. The code throws error saying 'Method 'AutoFilter' of object 'Range" failed (run time error 1004). All excel sheets goes white and show nothing.

End If
srcWS.Range("A" & mon.row - 1).AutoFilter
Application.ScreenUpdating = True
End Sub

I just converted it to comment and code works normal. Now I've to go back to Trade Diary and manually remove the filter. Otherwise all okay.

 

[mumps]

Glad it worked out.

 

[Alex Blakenburg]

Now I've to go back to Trade Diary and manually remove the filter.

If you just want to remove any filters applied try this:

srcWS.AutoFilter.ShowAllData

If you want to actually remove the filter and filter buttons then try this:

srcWS.AutoFilterMode = False

 

[dinunan]

If you just want to remove any filters applied try this:

srcWS.AutoFilter.ShowAllData

If you want to actually remove the filter and filter buttons then try this:

srcWS.AutoFilterMode = False

Thanks Alex, it worked. I just added Application.cutcopymode = false to remove those moving dotted lines around the ranges. Now everything is perfect.

 

[dinunan]

Hello @mumps and @Alex Blakenburg
There is an issue in the code. First time when code runs it creates the new sheets and updates the monthly data. On subsequent days, it just copies the whole of month data(Aug in this case) and pastes it below the existing data in my existing sheets. Means now I have double entries one below the other. Last five days I've those many double entries. Can you please look into it. May be we should add month column in other sheets as well and find it before paste?