VBA question

[lakaca]

I have a 3 sheet Excel spreadsheet that I want to paste data onto the top sheet each week and based on student IDs in column A and the criteria ("Yes" or "No") in column M, have a range of data (M-AQ) returned to the other 2 sheets. Sheet Met ("Yes") and Sheet Unmet (No"). This is the VBA code so far, and it returns an error of "Block if without End if". It worked at first but did not return the range I wanted. Any help is appreciated!

Sub Copy_BasedOnValue()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim lr1 As Long, lr2 As Long, lr3 As Long

Set sh1 = Sheets("Data")
Set sh2 = Sheets("Yes")
Set sh3 = Sheets("No")

lr1 = sh1.Range("M" & Rows.Count).End(3).Row
lr2 = sh2.UsedRange.Rows.Count
lr3 = sh3.UsedRange.Rows.Count
If Application.WorksheetFunction.CountA(sh2.UsedRange) = 0 Then lr2 = 0

If Application.WorksheetFunction.CountA(sh3.UsedRange) = 0 Then lr3 = 0

If WorksheetFunction.CountIf(sh1.Range("M3:M" & lr1), "Yes") > 0 Then
sh1.Range("A2:M" & lr1).AutoFilter 1, "No"
sh1.AutoFilter.Range.Range("A2:AE" & lr1).Copy sh2.Range("A" & lr2 + 1)
sh1.ShowAllData

If WorksheetFunction.CountIf(sh1.Range("M3:M" & lr1), "No") > 0 Then
sh1.Range("A2:M" & lr1).AutoFilter 1, "No"
sh1.AutoFilter.Range.Range("A2:AE" & lr1).Copy sh3.Range("A" & lr3 + 1)
sh1.ShowAllData

End If

End Sub

 

[Joe4]

Welcome to the Board!

That error statement is telling you EXACTLY what your issue is.

You have two IF statements, and only one END IF.

If WorksheetFunction.CountIf(sh1.Range("M3:M" & lr1), "Yes") > 0 Then
sh1.Range("A2:M" & lr1).AutoFilter 1, "No"
sh1.AutoFilter.Range.Range("A2:AE" & lr1).Copy sh2.Range("A" & lr2 + 1)
sh1.ShowAllData

If WorksheetFunction.CountIf(sh1.Range("M3:M" & lr1), "No") > 0 Then
sh1.Range("A2:M" & lr1).AutoFilter 1, "No"
sh1.AutoFilter.Range.Range("A2:AE" & lr1).Copy sh3.Range("A" & lr3 + 1)
sh1.ShowAllData

End If

Unless the entire IT/THEN is combined all on one line (like these two you wrote):

If Application.WorksheetFunction.CountA(sh2.UsedRange) = 0 Then lr2 = 0

If Application.WorksheetFunction.CountA(sh3.UsedRange) = 0 Then lr3 = 0

each IF needs a correspinding END IF!

So you are short one END IF!

 

[lakaca]

That did not help. I redid the whole thing and now it says "Subscript out of Range".

Sub Copy_BasedOnValue()

Dim wsDATA As Worksheet
Dim wsMET As Worksheet
Dim wsUNMET As Worksheet
Dim lastRow As Long
Dim i As Long
Dim METRow As Long
Dim UNMETRow As Long

Set wsDATA = ThisWorkbook.Sheets("DATA")
Set wsMET = ThisWorkbook.Sheets("MET")
Set wsUNMET = ThisWorkbook.Sheets("UNMET")

lastRow = wsDATA.Cells(wsDATA.Rows.Count, "A").End(xlUp).Row

METRow = 1
UNMETRow = 1

For i = 1 To lastRow

If wsDATA.Cells(i, "M").Value = "Yes" Then

wsDATA.Range(wsDATA.Cells(i, "M"), wsDATA.Cells(i, "AQ")).Copy
wsMET.Cells(METRow, "M").PasteSpecial Paste:=xlPasteValues
METRow = METRow + 1

ElseIf wsDATA.Cells(i, "M").Value = "No" Then

wsDATA.Range(wsDATA.Cells(i, "M"), wsDATA.Cells(i, "AQ")).Copy
wsUNMET.Cells(UNMETRow, "M").PasteSpecial Paste:=xlPasteValues
UNMETRow = UNMETRow + 1
End If
Next i

End Sub

 

[lakaca]

Dropbox

www.dropbox.com

Link to sample sheet?

 

[Joe4]

That did not help.

Well, it should have explained what you issue is. Did you try adding a second "END IF" and see if that fixes your issue?

Your second code is totally different than the first.
When you get the error, do you get a "Debug" option?
If so, click it and tell us what line of code it is highlighting. That is the most likely source of your error.

I do not have the ability to download files from my present location, so I cannot look at your workbook right now.

It would be most helpful if you could show us two things:
1. Your initial sheet (with any sensitive data first removed)
2. What you want your results after running the code to look like

 

[Skyybot]

Well, it should have explained what you issue is. Did you try adding a second "END IF" and see if that fixes your issue?

Your second code is totally different than the first.
When you get the error, do you get a "Debug" option?
If so, click it and tell us what line of code it is highlighting. That is the most likely source of your error.

I do not have the ability to download files from my present location, so I cannot look at your workbook right now.

It would be most helpful if you could show us two things:
1. Your initial sheet (with any sensitive data first removed)
2. What you want your results after running the code to look like

And please post any code in VBA code tags. Select code text and click on the VBA icon above.
No tags:
Sub AnySub()
MsgBox "No code tags"
End Sub
Tags:

Sub AnySub()
MsgBox "Code tags"
End Sub

 

[Skyybot]

If I understand your logic, this may help.

Sub Copy_BasedOnValue()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim lr1 As Long, lr2 As Long, lr3 As Long

Set sh1 = Sheets("Data")
Set sh2 = Sheets("Yes")
Set sh3 = Sheets("No")

lr1 = sh1.Range("M" & Rows.Count).End(3).Row
lr2 = sh2.UsedRange.Rows.Count
lr3 = sh3.UsedRange.Rows.Count
If Application.WorksheetFunction.CountA(sh2.UsedRange) = 0 Then lr2 = 0

If Application.WorksheetFunction.CountA(sh3.UsedRange) = 0 Then lr3 = 0

If WorksheetFunction.CountIf(sh1.Range("M3:M" & lr1), "Yes") > 0 Then
sh1.Range("A2:M" & lr1).AutoFilter 1, "No"
sh1.AutoFilter.Range.Range("A2:AE" & lr1).Copy sh2.Range("A" & lr2 + 1)
sh1.ShowAllData
End If

If WorksheetFunction.CountIf(sh1.Range("M3:M" & lr1), "No") > 0 Then
sh1.Range("A2:M" & lr1).AutoFilter 1, "No"
sh1.AutoFilter.Range.Range("A2:AE" & lr1).Copy sh3.Range("A" & lr3 + 1)
sh1.ShowAllData
End If

End Sub