Help with VBA Formula/Code

P

Psygrrl88

New Member
Joined
Dec 6, 2021
Messages
14
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
The intended effect: The code filters the table (Table1) on Sheet("AutoCensusReport") according to the EditLine# autofilter conditions. Then, if there are any rows that ARENT hidden it selects the unhidden cells that aren't blank in range A and pastes them in the first empty cell in range A on Sheet("Edits") then it unfilters the Table and goes to the next editline# (REPEAT).

Current Issues: I keep getting errors - notibly for the showalldata sections, but other times if there aren't any filtered rows (or something is wonky with the filters???) it is copying and pasting even the hidden rows for some reason instead of skipping to the next edit.

The Code:
VBA Code: 
Sub DemographicsThree()
'
' Demographics Macro 3
' Demographics Edits 21-27
'

'
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:="MO"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=42, Criteria1:="="
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
    Dim Sht As Worksheet
    Dim HidCnt As Long
    Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "21"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "State = MO, County = BLANK"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
Edit22:
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=42, Criteria1:="<>"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:="<>MO"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
    Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    MsgBox "No Errors Edit 21"
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "22"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "State not = MO, County not = BLANK"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
Edit23:
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:="="
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=54, Criteria1:="=", Operator:=xlOr, Criteria2:="US"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
        Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    MsgBox "No Errors Edit 21"
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "23"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "State = BLANK, Country = BLANK or US"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
Edit24:
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=25, Criteria1:="MSEP"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:=Array("KS", "MI", "MN", "ND", "WI", "IL", "IN")
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
        Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    MsgBox "No Errors Edit 21"
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "24"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "Student Type = MSEP, State not = KS, MI, MN, NE, ND, WI, IL, IN"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
Edit25:
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=46, Criteria1:="="
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
        Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    MsgBox "No Errors Edit 21"
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "25"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "Residency = BLANK"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
Edit26:
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=45, Criteria1:="="
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
        Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    MsgBox "No Errors Edit 21"
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "26"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "Location = BLANK"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
Edit27:
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=34, Criteria1:=">4"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"
        Set Sht = Sheets("AutoCensusReport")
            If Sht.AutoFilterMode = True Then
            HidCnt = Sht.Rows.Count - Sht.Range("A:A").SpecialCells(xlCellTypeVisible).Count
                If HidCnt > 0 Then
                    MsgBox "No Errors Edit 21"
                    Tbl.AutoFilter.ShowAllData
                    GoTo Edit22
                End If
            End If
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    Sheets("Edits Sheet").Select
        Range("A2").Select
        Selection.End(xlDown).Range("A2").Select
        ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Demographics"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "27"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "L35 Cen Term Cum GPA > 4.0"
    If Sht.AutoFilterMode = True Then
        Tbl.AutoFilter.ShowAllData
    End If
EndProc:
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
VBA Code: 
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:="MO"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=42, Criteria1:="="
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"

You could put a sample of your data, it can be generic data to see what data you want to filter, what you want to copy and where you want to paste it.


VBA Code: 
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=42, Criteria1:="<>"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:="<>MO"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"

The same, a sample of your data

VBA Code: 
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=44, Criteria1:="="
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=54, Criteria1:="=", Operator:=xlOr, Criteria2:="US"
    Worksheets("AutoCensusReport").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=">0"

The same, a sample of your data


______________________________________________
What do you want to copy? All records filtered? or just the first record?
 
Upvote 0
DanteAmor said:
What do you want to copy? All records filtered? or just the first record?
Click to expand...
It is important to see the copied records and also see the result that you want in the "Edits Sheet" sheet.
 
Upvote 0
This is the data I am working with. Column A is the student ID, then Columns B-BJ contain various information about each student that is filled from a report ran in another program. That report gets pasted into the "Paste Sheet" sheet and the autocensusreport is supposed to automatically edit the data using vlookup ect to put it into the correct format for a dashboard that we maintain. Sometimes the report is wrong, and sometimes the program we get the report from is missing key information, so we have a list of 90 edits we have to check before it goes into the dashboard. Normally this takes two-three weeks to finish, I am trying to automate at least some of the process. Not all of the edits can be done automatically.

each macro is supposed to filter the data using criteria such as "Gender column is blank" or "If bldg is blank and room is not blank" ect. then copy the appropriate student id's and paste them in the first available blank cell in the edits sheet.

I have added "Debug" students so that it is readily apparent when no students have that edit required - as the only copied student ID should be the debug error
1639741907195.png


The only information I need to copy is the student ID (Column A) - the name is a vlookup from the census report and the macro fills in the edit section, edit # and description
The goal is to get a list of student ID's and what needs to be fixed on them so that the edits can be sent to the appropriate departments for correction in the system as well as the dashboard.
1639741929106.png
 
Last edited:
Upvote 0
I simplified the code for edit 21 to 27.
Put all the code in your module and try the macro "DemographicsThree_1"

VBA Code: 
Sub DemographicsThree_1()
  Dim shE As Worksheet
  Dim tbl As ListObject
  Dim nCount As Long
  
  Application.ScreenUpdating = False
  Set shE = Sheets("Edits Sheet")
  Set tbl = Sheets("AutoCensusReport").ListObjects("Table1")
  
  'Edit 21
  Call FilterData(tbl, 1, ">0", 42, "=")
  tbl.Range.AutoFilter Field:=44, Criteria1:="MO"
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "21", "State = MO, County = BLANK")

  'Edit 22
  Call FilterData(tbl, 1, ">0", 42, "<>")
  tbl.Range.AutoFilter Field:=44, Criteria1:="<>MO"
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "22", "State not = MO, County not = BLANK")

  'Edit 23
  Call FilterData(tbl, 1, ">0", 44, "=")
  tbl.Range.AutoFilter Field:=54, Criteria1:="=", Operator:=xlOr, Criteria2:="US"
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "23", "State = BLANK, Country = BLANK or US")

  'Edit24
  Call FilterData(tbl, 1, ">0", 25, "MSEP")
  tbl.Range.AutoFilter Field:=44, Criteria1:=Array("KS", "MI", "MN", "ND", "WI", "IL", "IN"), Operator:=xlFilterValues
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "24", "Student Type = MSEP, State not = KS, MI, MN, NE, ND, WI, IL, IN")

  'Edit25
  Call FilterData(tbl, 1, ">0", 46, "=")
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "25", "Residency = BLANK")

  'Edit26
  Call FilterData(tbl, 1, ">0", 45, "=")
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "26", "Location = BLANK")
    
  'Edit27
  Call FilterData(tbl, 1, ">0", 34, ">4")
  nCount = tbl.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
  If nCount > 0 Then Call CopyStudentId(shE, tbl, nCount, "Demographics", "27", "L35 Cen Term Cum GPA > 4.0")
    
  tbl.AutoFilter.ShowAllData
  Application.CutCopyMode = False
End Sub

Sub CopyStudentId(shE, tbl, nCount, txt1 As String, txt2 As String, txt3 As String)
  Dim lr As Long
  lr = shE.Range("A" & Rows.Count).End(3)(2).Row
  tbl.Range.Columns(1).Offset(1).Copy
  shE.Range("A" & lr).PasteSpecial xlPasteValues
  shE.Range("D" & lr).Resize(nCount).Value = txt1
  shE.Range("E" & lr).Resize(nCount).Value = txt2
  shE.Range("F" & lr).Resize(nCount).Value = txt3
End Sub

Sub FilterData(tbl As Object, fld1 As Long, crit1 As String, fld2 As Long, crit2 As String)
  tbl.AutoFilter.ShowAllData
  tbl.Range.AutoFilter Field:=fld1, Criteria1:=crit1
  tbl.Range.AutoFilter Field:=fld2, Criteria1:=crit2
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Macro to filter each column for cells that appear empty, clear the contents and move to the next column for entire table
Replies
3
Views
540
sspatriots
S
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
604
dinunan
D
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
264
rlv01
R
G
  • Question Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
751
GardianAngelUK
G
M
  • Question Question
Table issue with VBA
Replies
2
Views
387
Mike2
M

Forum statistics

Threads
1,223,911
Messages
6,175,329
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top