I'm having trouble with this VBA - my for loop only iterates once, and when it increments it says that the method "Cells" in object "Worksheet" failed. It worked the first iteration though... I think my StatusUpdate function is breaking it, but when I comment it out, it fails anyway. Does anything stand out in the main sub to anyone? Happy to post more code if needed.
Sub CreateSlides()
Dim XLapp As New Excel.Workbook
Dim WS As New Excel.Worksheet
Set XLapp = Excel.Workbooks.Open("J:\OPERATIONS\CAPITAL PROJECTS\Clara\test.xlsx")
Set WS = XLapp.Sheets(1)
XLapp.Activate
WS.Select
Dim CD As Integer
CD = 0
Dim cell As Range
Dim i As Integer
Dim LastRow As Integer
LastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row
'Delete old slides
If ActivePresentation.Slides.Count > 1 Then
Call DeleteSlides
End If
'Loop through each used row in Column A
For i = 2 To LastRow
CD = WS.Cells(i, 35).Value
ActivePresentation.Slides(1).Copy
ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("project").TextFrame.TextRange = WS.Cells(i, 7).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("park location").TextFrame.TextRange = WS.Cells(i, 9).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("cb").TextFrame.TextRange = Right(WS.Cells(i, 36).Text, 2)
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("cm").TextFrame.TextRange = (CouncilMember(CD))
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("scope").TextFrame.TextRange = WS.Cells(i, 8).Value
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("funding").TextFrame.TextRange = FundingEst(i)
ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes("status").TextFrame.TextRange = StatusUpdate(i)
Next
End Sub
you a re not running through column a but to the 35th column in the sheet. change
CD = WS.Cells(i, 35).Value
to
CD = WS.Cells(i, 1).Value
Also, if whatever is in those cells is not an integer, but text or something else, you will get an error?
Related
From Sheet1 and Sheet2, if a cell from B column has "In Progress", then I want to copy that entire row to another Sheet4.
I want to repeat it for all rows of both the sheets.
Sub Demo1()
Dim wb As Workbook
Dim ws As Worksheet, sh As Worksheet
Dim lastrow As Long
Dim w As Integer
Dim i As Integer
Set wb = Workbooks(Book1)
Set ws = Worksheets("Sheet4")
Set sh = ActiveSheet
For w = 1 To wb.Sheets.Count
For i = 1 To lastrow
If ActiveSheetCells(i, 2).Value = "In Progress" Then
wb.ws.Cells(1, 1).Insert
Else
If Cells(i, 2).Value = "" And i < 50 Then
ActiveCell.Offset(1, 0).Select
End If
Cells(i, 2).Value = "" And i > 49
Next i
Next w
End Sub
Error Message
Sheet 1
Sheet 2
Sheet 3
Quick review on your code, based on my comments to the post (untested):
Sub Demo1()
Dim wb As Workbook: Set wb = Workbooks("Book1")
Dim destinationSheet As Worksheet: Set destinationSheet = wb.Worksheets("Sheet4")
Dim sourceSheet As Worksheet: Set sourceSheet = ActiveSheet
With sourceSheet
Dim lastRowSource As Long: lastRowSource = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim w As Long, i As Long
For w = 1 To wb.Sheets.Count
For i = 1 To lastRowSource
If .Cells(i, 2).Value = "In Progress" Then
destinationSheet.Cells(1, 1).Insert
Else
If .Cells(i, 2).Value = "" And i < 50 Then
'Why are you Selecting and what are you doing with it?
.Cells(i,X).Offset(1, 0).Select 'Change from "activeCell" to an actual cell reference as you don't change the activecell when looping...
End If
Cells(i, 2).Value = "" And i > 49 'Is this supposed to be another If statement?
End If 'Added
Next i
Next w
End With
Don't use Integer, use Long; the prior gets converted within VBA so you can save the processing with using the latter.
Use descriptive variable names so you're not lost in 10 months re-looking at your code, or having someone else look at your code. For the most part, people should be able to understand what's happening without the use of excessive comments.
Do your best to not have a wall of variables. If you can dimension a variable just as it's being used, you're pairing things together and might catch that x as long when you're using it as a string a lot faster.
You have a .Select and nothing happens with that. Additionally, included as a comment, using ActiveCell is probably not what you want... use a direct cell reference. Note that when you loop, VBA will change its references, however it does not physically change its activecell.
You have what appears to be another If statement which does not include any If / Then for the i > 49 bit.
The culprit of your error is the lack of End If, which is now placed with the comment Added.
I have written this code to eliminate columns based on header names. On one workbook I have the list of headers to delete, and on the other workbook I have the columns themselves.
'setup
Dim nominas_ws As Worksheet
Set nominas_ws = ActiveSheet
Dim conceptos_wb As Workbook
Set conceptos_wb = Workbooks.Open("C:\Users\deepw\Desktop\nominas\conceptos.xlsx")
Dim conceptos_ws As Worksheet
Set conceptos_ws = conceptos_wb.Worksheets(1)
Dim nominas_last_row, nominas_last_column, conceptos_last_row, conceptos_last_column As Long
nominas_last_row = nominas_ws.Cells(Rows.Count, 5).End(xlUp).Row
nominas_last_column = nominas_ws.Cells(1, Columns.Count).End(xlToLeft).Column
conceptos_last_row = conceptos_ws.Cells(Rows.Count, 5).End(xlUp).Row
conceptos_last_column = conceptos_ws.Cells(1, Columns.Count).End(xlToLeft).Column
'delete names & unwanted columns
nominas_ws.Range("C2:C" & nominas_last_row).ClearContents
Dim conceptos_headers As Range
Dim i, c As Integer
Dim concepto_input As String
For i = 2 To conceptos_last_row
concepto_input = conceptos_ws.Cells(i, 1).Value
For c = 1 To nominas_last_column
If Cells(c, 1).Value = "concepto_input" Then Cells(c, 1).EntireColumn.delete
Next c
Next i
Thank you in advance for your help.
If Cells(c, 1).Value = "concepto_input" Then
you are checking for the string literal "concepto_input", not the value in the variable concepto_input. Should be:
If Cells(c, 1).Value = concepto_input Then
If there might be multiple matches for any given column heading, you should loop backwards:
For i = 2 To conceptos_last_row
concepto_input = conceptos_ws.Cells(i, 1).Value
For c = nominas_last_column To 1 Step -1
If conceptos_ws.Cells(c, 1).Value = concepto_input Then
conceptos_ws.Columns(c).Delete
'Exit For 'if there can only be one match per search term
End If
Next c
Next i
Note it's also good practise to never use Range/Cells without an explicit worksheet qualifier.
In sheet 2 of my workbook, I have names of employees, the dates they came into work, the shifts they worked, and absenteeism. In sheet 1 of my code, I have a lookup sheet where I intend for the employee's name to be typed into a cell and to show all the dates and this person worked, along with the shift and absenteeism into the lookup sheet. I've tried a vriaty of things, but this is my current code:
Private Sub worksheet_change(ByVal Target As Range)
Dim Lookup As Worksheet
Dim Data As Worksheet
Dim LastRow As Long
Dim V As Range
Set Lookup = ThisWorkbook.Worksheets("Lookup")
Set Data = ThisWorkbook.Worksheets("Data")
Set V = Lookup.Range("A1:A2")
LastRow = Data.Cells(Rows.Count, "A").End(xlUp).Row
LookupCounter = 2
For i = 2 To LastRow
If Intersect(V, Target) Is Nothing Then
Lookup.Range("B2:C2000").Delete
ElseIf Lookup.Range("A2") = Data.Cells(i, 2) Then
Lookup.Cells(LookupCounter, 2).Value = Data.Cells(i, 1)
Lookup.Range("B2:B2000").NumberFormat = "mm/dd/yyyy"
Lookup.Cells(LookupCounter, 3).Value = Data.Cells(i, 9)
LookupCounter = LookupCounter + 1
End If
Next i
End Sub
My intention is for when a new name is typed, this clears the info from the columns of the lookup page, and inputs the new data for the new name. The second part of my code where I match the names to the dates works, but I am struggling with the clearing function. What can I do to fix it?
Option Explicit
Private Sub worksheet_change(ByVal Target As Range)
Dim Lookup As Worksheet, Data As Worksheet
Dim LastRow As Long, LookupCounter As Long, i As Long
With ThisWorkbook
Set Lookup = .Worksheets("Lookup")
Set Data = .Worksheets("Data")
End With
If Intersect(Lookup.Range("A1:A2"), Target) Is Nothing Then
Exit Sub
Else
' clear sheet
Lookup.Range("B2:C2000").Delete
LastRow = Data.Cells(Rows.Count, "A").End(xlUp).Row
LookupCounter = 2
' get data
For i = 2 To LastRow
If Data.Cells(i, 2) = Lookup.Range("A2") Then
Lookup.Cells(LookupCounter, 2).Value = Data.Cells(i, 1)
Lookup.Cells(LookupCounter, 3).Value = Data.Cells(i, 9)
LookupCounter = LookupCounter + 1
End If
Next
Lookup.Range("B2:B2000").NumberFormat = "mm/dd/yyyy"
End If
End Sub
it's been a while since I've used VBA. I have a range of unique values that I would like to search a table for. And if those values exist in said table, delete the entire row.
I'm able to loop through and delete specific, singular values, but struggling with multiple. I have tried replacing "30ExGEPAc30Q4" (code below) with Range() and an array, but can't quite get it. Here's what I've got so far:
Sub test()
Dim x As Long
Dim lastrow As Long
lastrow = Sheets("LRP").ListObjects("Data_LRP").Range.Rows.Count
Worksheets("LRP").Activate
For x = lastrow To 1 Step -1
If Cells(x, 1).Value = "30ExGEPAc30Q4" Then
Rows(x).Delete
End If
Next x
End Sub
If I understand you correctly, this is what you're trying to achieve; I have cleaned up some of the unnecessary bits and now you just have to edit x and lastrow as is necessary.
Sub test()
Dim x As Long
Dim lastrow As Long
'lastrow = Sheets("LRP").ListObjects("Data_LRP").Range.Rows.Count
x = 1
lastrow = 21
'Worksheets("LRP").Activate
Do While x <= lastrow
' For x = lastrow To 1 Step -1
If Cells(x, 1).Value = "30ExGEPAc30Q4" Then
Rows(x).Delete
lastrow = lastrow - 1
Else
x = x + 1
End If
' Next x
Loop
End Sub
For those curious, it ended up looking like this. Thanks for all the help!
Sub Cull()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht1row As Long
Dim sht2row As Long
Dim sht2total As Long
Dim DupID As String
Set sht1 = Worksheets("Data Form")
Set sht2 = Worksheets("LRP")
sht2.Activate
sht2total = Worksheets("LRP").ListObjects("Data_LRP").Range.Rows.Count
sht1row = 33
Do While sht1.Cells(sht1row, 2).Value <> ""
DupID = sht1.Cells(sht1row, 2).Value
For sht2row = 2 To sht2total
If DupID = Cells(sht2row, 1).Value Then
Rows(sht2row).Delete
sht2row = sht2row - 1
Exit For
End If
Next
sht1row = sht1row + 1
Loop
End Sub
Sub Random()
'if you have questions or you broke the macro, reach out to the AU DataDudes!
Dim J As Integer
Dim P As Integer
Dim V As Integer
Dim Production As Worksheet
Dim Distro As Worksheet
Dim IRowL As Integer
Dim ProwL As Integer
Dim StartRange As Range
Set Production = Worksheets("Alias Production Detail Report")
Set Distro = Worksheets("WorkList")
IRowL = Distro.Cells(Distro.Rows.Count, "A").End(xlUp).Row 'if you changed the location of the Name in the Gracie sheet change this
ProwL = Production.Cells(Production.Rows.Count, "A").End(xlUp).Row 'if you change the location of the name in the master sheet change this
Application.ScreenUpdating = False
For J = 2 To IRowL
For P = 2 To ProwL
If Distro.Cells(J, 1).Value = Production.Cells(P, 6).Value Then
If Production.Cells(P, 5).Value <> Distro.Cells((J - 1), 5).Value Then
Production.Cells(P, 1).EntireRow.Copy
Distro.Cells(J, 1).Select
ActiveSheet.Paste
Exit For
End If
End If
Next P
Next J
Application.ScreenUpdating = True
MsgBox ("All Done!")
Did a super primitive approach to a small equivalent for VBA but it will only work for instances of 2,
If Production.Cells(P, 5).Value <> Distro.Cells((J - 1), 5).Value
Can someone provide the approach/thought process regarding using small within the loop resulting can continually get the next instance instead of the same one over and over.