VBA code to generate report based on criteria

[kkyuvaraj]

Hi,

I have an excel sheet (Attached in this thread) with sheets "Checklist" & "CAR", in which i need a VBA code in the checklist sheer in "Generate CAR" button and if click that button CAR report to be generated in "CAR" sheet as provided in the attached excel sheet.

1. VBA code should filter the field "I5" if I6 to I127=CAR, then the filtered data from C6:H127 has to be copied and pasted to "CAR" sheet as given in the attached excel.
2.Further if any data changed in "Checklist" and I click "Generate CAP" again then the previously copied/pasted data in "CAR" has to be removed and fresh data has to be copied & pasted in "CAR" sheet.
3. After copy & paste to "CAR", checklist list show full list without filter.

Experts pls help to create the VBA code as above

by

Yuvaraj

[Bob Phillips]

This should do it

Public Sub GenerateCAR()
Dim wsCAR As Worksheet
Dim wsChecklist As Worksheet
Dim lastrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wsChecklist = Worksheets("Checklist")
    With wsChecklist
    
        lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With
    
    Call DeleteSheet("CAR")
    Set wsCAR = Worksheets.Add(After:=wsChecklist)
    wsCAR.Name = "CAR"
    
    With wsCAR
    
        With .Range("C2:H2")
        
            .MergeCells = True
            .Value = "CORRECTIVE ACTION REPORT"
            .HorizontalAlignment = xlCenter
            .Font.Size = 20
            
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 49407
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            
            .BorderAround Weight:=xlMedium, LineStyle:=xlContinuous
        End With
    
        For i = 3 To 8
        
            .Columns(i).ColumnWidth = wsChecklist.Columns(i).ColumnWidth
        Next i
        .Columns("E").ColumnWidth = 12
        
        With wsChecklist.Range("C5").Resize(lastrow - 4, 7)
        
            .AutoFilter Field:=7, Criteria1:="<>"
            .Copy wsCAR.Range("C4")
            .AutoFilter
        End With
        
        wsCAR.Columns("I").Delete
    End With
    
    Debug.Print "All done - " & Now()

    Application.ScreenUpdating = True
End Sub

Private Function DeleteSheet(ByVal sh As String) As Boolean

    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(sh).Delete
End Function

[大灰狼1976]

Hi Yuvaraj!

Sub Test()
  Dim rng As Range
  Application.ScreenUpdating = False
  With Sheets("Checklist")
    Set rng = .Range("b5:i" & Cells(Rows.Count, 3).End(3).Row)
    rng.AutoFilter Field:=8, Criteria1:="CAR"
    Sheets("CAR").[c2].CurrentRegion.Offset(3).Clear
    .Range("c6:c" & Cells(Rows.Count, 3).End(3).Row).Resize(, 6).Copy Sheets("CAR").[c5]
    rng.AutoFilter Field:=8
  End With
  Application.ScreenUpdating = True
End Sub

[kkyuvaraj]

Hi,

Thanks for your response, however if altered any data and regenerate the CAR, then the previous CAR data remains as it is but if I alter any data in checklist and regenerate CAR then all data in CAR has to be removed and new altered data has to be paste din CAR.

[kkyuvaraj]

Hi,

Thanks a ton and it solved my purpose.