I am receiving a next without for error from:
Sub CTLines()
Dim iVal As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Set ws1 = Worksheets("INCIDENTS")
Set ws2 = Worksheets("INCDB")
iVal = Application.WorksheetFunction.CountIf(Range("AO5:AO999"), "Yes")
Dim i
For i = 1 To iVal
With Sheets("INCDB")
.Range("5:5").Insert Shift:=x1Down
Next i
End Sub
I've tried changing the variable, the indent, many things and I've not been successful.
All I want to do is to count how many rows contain Yes in the AO column and add as many rows in the INCDB spreadsheet.
Change the code to this, near the bottom:
For i = 1 To iVal
With Sheets("INCDB")
.Range("5:5").Insert Shift:=xlDown
End With
Next i
The VBA compiler is not good at reporting what is wrong, when it encounters code that has one or more lines that are missing a matching termination line.
In your case you never terminated the With statement.
Related
I am trying to write a vba script that will allow me to vlookup values from Sheet(3) to different Sheet(i) - and paste it on range"R2" on the Sheet(i) - I also want it to go to the end of the values in Column M on Sheet(i) [if this is possible]. I basically want to run through all the different "i" sheets on the workbook. Sheet (3) has all the data that needs to be copied on all the other "i" sheets.
I keep getting an error with my code below.
Sub CopyTableau1Data()
Dim wka As Worksheet
Dim wkb As Worksheet
ShtCount = ActiveWorkbook.Sheets.Count
For i = 9 To ShtCount
With ThisWorkbook
Set wka = .Sheets(i)
Set wkb = .Sheets(3)
End With
Worksheets(i).Activate
If IsError(Application.WorksheetFunction.VLookup(wka.Range("M2"), wkb.Range("E:T"), 14, 0)) Then
wka.Range("R2").Value = ""
Else
wka.Range("R2").Value = Application.WorksheetFunction.VLookup(wka.Range("M2"), wks.Range("E:T"), 14, 0)
End If
Next i
End Sub
IsError does not work with Application.WorksheetFunction.VLookup or WorksheetFunction.VLookup, only with Application.VLookup.
It is faster and easier to return Application.Match once to a variant type variable and then test that for use.
dim am as variant
'are you sure you want wkb and not wks here?
am = Application.match(wka.Range("M2"), wkb.Range("E:E"), 0)
If IsError(am) Then
wka.Range("R2") = vbnullstring
Else
'are you sure you want wks and not wkb here?
wka.Range("R2") = wks.cells(am, "R").value
End If
Note the apparent misuse of wkb and wks in two places. I don't see the point of looking up a value in one worksheet, testing that return then using the results of the test to lookup the same value in another worksheet.
You can use the following code:
Sub CopyTableau1Data()
Dim wka As Worksheet
Dim wkb As Worksheet, i As Integer
ShtCount = ActiveWorkbook.Sheets.Count
For i = 9 To ShtCount
With ThisWorkbook
Set wka = .Sheets(i)
Set wkb = .Sheets(3)
End With
Worksheets(i).Activate
wka.Range("R2") = aVL(i)
Next i
End Sub
Function aVL(ByVal wsno As Integer) As String
On Error GoTo errhandler:
aVL =
Application.WorksheetFunction.VLookup(ActiveWorkbook.Worksheets(wsno).Range("M2"),
ActiveWorkbook.Worksheets(3).Range("E:T"), 14, False)
errhandler:
aVL = ""
End Function
When you try to check an error by isError, program flow can immediately return from the sub depending on the error. You could use on error in your sub to prevent that but this would only handle the first error. By delegating the error handling to a function you can repeatedly handle errors in your loop.
I assumed you wanted to use wkb.Range("E:T") instead of wks.Range("E:T").
So I have a pivottable and in column C there is field for which I am showing details for each record using this
For i=7 to 10
DATA.Range("C" & i).ShowDetail = True
Set wN = ThisWorkbook.Worksheets(1)
Next i
Now it works fine but the problem is Set wN = ThisWorkbook.Worksheets(1) assigns the wN the first worksheet but DATA.Range("C" & i).ShowDetail = True sometimes inserts the new worksheet which has the details at 1st or 2nd position. Now I want to know which was the new worksheet which was inserted and assign wN to it.
Do I have to make an array or list which keeps record of existing worksheets and then check which is the new one everytime? or there is an easy way to determine which is the newest worksheet in an workbook irrespective of the position.
Look at the Activesheet. ShowDetail creates the new sheet and activates it - so Set wn=ActiveSheet should work.
Sub Test()
Dim c As Range
Dim wrkSht As Worksheet
With ThisWorkbook.Worksheets("Sheet2").PivotTables(1)
For Each c In .DataBodyRange.Resize(, 1)
c.ShowDetail = True
Set wrkSht = ActiveSheet
Debug.Print wrkSht.Name
Next c
End With
End Sub
This link to Jon Peltiers page on Pivot Tables should be a massive help... https://peltiertech.com/referencing-pivot-table-ranges-in-vba/
The code shown does not add a worksheet, it sets wN to whatever sheet has index 1 (The second sheet created).
Try wN.Name = "C"& i & " field" to help figure out when each sheet is being created.
Open a new Workbook. Then run this code a few times:
Option Explicit
Public Sub TestMe()
Dim wsNew As Worksheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wsNew = Worksheets(Worksheets.Count)
Debug.Print wsNew.Name
End Sub
You would see, that wsNew is always the last one added. Thus with Worksheetes(Worksheets.Count) you may access it.
Edit:
If you want to know the name of the last added Worksheet, without adding After:, then use collection to remember all the worksheets you had before and simply compare them with the new collection. Run this code a few times:
Option Explicit
Public Sub TestMe()
Dim wsCollection As New Collection
Dim lngCounter As Long
Dim strName As String
Dim blnNameFound As Boolean
Dim ws As Worksheet
For Each ws In Worksheets
wsCollection.Add ws.Name
Next ws
Worksheets.Add
For Each ws In Worksheets
blnNameFound = False
For lngCounter = 1 To wsCollection.Count
If wsCollection.Item(lngCounter) = ws.Name Then
blnNameFound = True
End If
Next lngCounter
If Not blnNameFound Then Debug.Print ws.Name
Next ws
End Sub
The complexity is O².
Yesterday I decided to learn some VBA to make my excel time easier. It has been going better then expected, but I have been breaking my teeth on this code for many hours now.
I am trying to remove all empty (except title) columns, and this in all sheets of a workbook.
After lots of googling I managed to find some examples i could adapt to my needs.
I used this code: remove columns
and then tried to loop it through the sheets by using dear old microsoft support
Together i frankensteined it into this:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim MyRange As Range
Dim iCounter As Long
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
'removecode
' Define the target Range.
Set MyRange = ActiveWorkbook.Worksheets(I).UsedRange
'Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'If entire column is empty then delete it.
If Application.CountA(Columns(iCounter).EntireColumn) = 1 Then
Columns(iCounter).Delete
End If
Next iCounter
'endremovecode
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
When I run this, only the the starting worksheet is cleaned up. The messagebox does loop through all of them.
Why? What am I doing wrong?
I tried finding a solution, but non of the topics here seemed to give more clarity.
Thank a bunch for leading me in the right direction.
Lara
Columns(iCounter).EntireColumn
and
Columns(iCounter).Delete
are not prefixed with MyRange so refer to the active sheet's columns not the sheet containing MyRange. Stick MyRange. infront of them.
You're almost there. You just need to qualify your application.counta and also your .columns().delete. so each is working directly with the sheet in question. Otherwise it's just working with the active sheet.
Try this:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim MyRange As Range
Dim iCounter As Long
Dim ws As Worksheet
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Set ws = ActiveWorkbook.Worksheets(I)
'removecode
With ws
' Define the target Range.
Set MyRange = .UsedRange
'Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'If entire column is empty then delete it.
If Application.CountA(.Columns(iCounter).EntireColumn) = 0 Then
.Columns(iCounter).Delete
End If
Next iCounter
End With
'endremovecode
MsgBox ws.Name
Next I
End Sub
I am trying to loop through a list of (randomly named) worksheets and for each calculate the last row and then loop though all the rows and execute some code.
I've tried the code below but I'm getting Invalid Procedure Call or Argument. I've modified in all kinds of ways but it's driving me crazy...thank you in advance.
Sub myloop()
Dim ws As Variant
Dim WsArray As Variant
Dim rcount As Integer
WsArray = Array("mysheet1", "mysheet2", "mysheet3", "mysheet4")
With ThisWorkbook
For Each ws In WsArray
rcount = .Worksheets(ws).Cells("A1").End(xlDown).Row
For i = 1 To rcount
If ...Then
End If
Next
Next
End With
End Sub
#Santosh makes a great point about finding the last row. As for the original question, in any Workbook there exists a Worksheets collection that might actually be easier to loop through depending on your structure:
Dim ws As Worksheet
For Each ws In Worksheets
'match worksheet names if necessary using ws.Name...
'
'do other cool stuff...
'
'wrap it all up
Next ws
Try this. Instead of going to cell A1 and going down to find the last row its better to go to last cell (rows.count) and then go up.
Sub myloop()
Dim ws As Variant
Dim WsArray As Variant
Dim rcount As Integer
WsArray = Array("mysheet1", "mysheet2", "mysheet3", "mysheet4")
With ThisWorkbook
For Each ws In WsArray
With .Worksheets(ws)
rcount = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To rcount
'If .. Then
End If
Next
Next
End With
End Sub
I am new to VBA and building off of someone else's code, who was newer to VBA than me! Thanks in advance for any tips and advice you may have.
Since I cannot post the image I will attempt to describe the dataset. The data is from a userform, with the bulk of the content in a table range A14:M34, with questions in column A, and data in columns B-M. The first row is a header the user populates identifying the unit inspected. The data below is populated with pull downs with blank, Yes and NO as options, and a few rows with numeric or character strings.
I want to test each cell in a variably sized range for unanswered questions and notify the user if there are any and give them the option to complete the dataset before submitting.
Sub new_p()
Static AbortProc As Boolean
Dim iRow As Long
Dim LastColumn As Long
Dim aCol As Long
Dim ws As Worksheet, WS1 As Worksheet
Dim InputRange As Range
Set ws = Worksheets("PreparationData")
Set WS1 = Worksheets("ColdWeatherPreparation")
Set InputRange = WS1.Range("B15:M34")
If AbortProc Then Exit Sub
'find last column in range
LastColumn = WS1.Cells(14, 2).End(xlToRight).Column
'define variable range of columns
For aCol = 2 To LastColumn
'check that the circuit row is not blank
'If Cells(14, aCol) Is Not Nothing Then
If IsEmpty(InputRange) Then
Msg = "All fields are not populated. Stop submission to resume editing?"
Ans = MsgBox(Msg, vbYesNo)
'if yes stop process
If Ans = vbYes Then
AbortProc = True
Exit Sub
End If
'if no run rest of script
If Ans = vbNo Then
MsgBox "Run without Correcting?"
AbortProc = False
Exit Sub
End If
End If
'End If
Next
'more code here that seems to be working
End Sub
You'll see I have commented out a line I think is redundant. If End(xlToRight) generates the last populated column of the header row then they are not blank, so no need to test. Nonetheless I keep code I am not using until the final checks are done and it is proven to be completely useless. The excessive commenting is to help a large group of non-VBA staffers follow and verify my code before implementing.
So the LastColumn definition seems to work, and I use it again later. When I step through the code it cycles through the correct number of times for my bogus dataset. I feel like the isEmpty is where I am falling down.
If every cell in B15:M34 should be non-blank, then you can do this:
If Application.CountBlank(InputRange)>0 Then
If Msgbox(Msg, vbYesNo) = vbYes Then
'rest of your code
End If
End If
EDIT: this will check each data cell against the corresponding header cell.
Sub new_p()
Static AbortProc As Boolean
Dim iRow As Long
Dim LastColumn As Long
Dim aCol As Long
Dim ws As Worksheet, WS1 As Worksheet
Dim InputRange As Range, rw As Range
Dim HeaderRange As Range
Dim x As Long, Msg As String
Set ws = Worksheets("PreparationData")
Set WS1 = Worksheets("ColdWeatherPreparation")
Set HeaderRange = WS1.Range("B14:M14")
Set InputRange = WS1.Range("B15:M34")
'are you sure about this next line?
'once validation has failed once how does it re-run?
If AbortProc Then Exit Sub
For Each rw In InputRange.Rows
For x = 1 To rw.Cells.Count
If Len(rw.Cells(x).Value) = 0 And _
Len(Headerange.Cells(x).Value) > 0 Then
Msg = "All fields are not populated. Stop submission" & _
" to resume editing?"
If MsgBox(Msg, vbYesNo) = vbYes Then
AbortProc = True
Exit Sub
Else
MsgBox "Run without Correcting?"
AbortProc = False
Exit Sub
End If
End If
Next x
Next rw
'more code here that seems to be working
End Sub
Errors at Len line? Maybe, because Cells has 2 parameters? Cells(RowIndex,ColumnIndex).
Also, you can set LastColumn by:
LastColumn = ActiveSheet.UsedRange.Columns.Count
same thing can be done for rows:
LastRow = ActiveSheet.UsedRange.Rows.Count
Maybe you should move If AbortProc Then Exit Sub inside For loop (as first/last line)