Code was working fine up until a couple of days ago but now getting the subject-line error. Help?
Sub CopyRows()
Dim bottomL As Integer
Dim x As Integer
bottomL = Sheets("Pacer").Range("L" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Pacer").Range("A1:L" & bottomL)
If (c.Value = "AFSB" Or c.Value = "TEIGIP4T" Or c.Value = "EPP") Then
Intersect(c.Parent.Columns("A:Q"), c.EntireRow).Copy Worksheets("Portfolio").Range("A" & x + 1)
x = x + 1
End If
Next c
End Sub
Variable
bottomL As Integer
Will give overflow error the moment it exceeds 32,767 rows. Try declaring it as long
bottomL As Long
Edit: The rule applies to X as well as it is incrementing.
Try this
Option Explicit
Sub CopyRows()
Dim bottomL As Long
Dim x As Long
bottomL = Sheets("Pacer").Range("L" & Rows.CountLarge).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Pacer").Range("A1:L" & bottomL)
If (c.Value = "AFSB" Or c.Value = "TEIGIP4T" Or c.Value = "EPP") Then
Intersect(c.Parent.Columns("A:Q"), c.EntireRow).Copy Worksheets("Portfolio").Range("A" & x + 1)
x = x + 1
End If
Next c
End Sub
Reason explained here
Related
I updated the code with the suggestions and worl, thank you all
But, I have another problem. I need to do this for every month of the year and for all the names on the worksheet (about 20 names).
This way the code will be very long, do you have any suggestions to make it more automated?
'''
Sub CountHSEcards()
Sub CountHSEcards()
Dim Sh As Worksheet
Dim Br As Worksheet
Set Sh = Sheets("Planilha1")
Set Br = Sheets("Brasil")
NultimaCelula = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
For i = 1 To NultimaCelula
If InStr(Sh.Range(CStr("AD" & i + 1)).Value, "Lucas") > 0 Then
If Month(Sh.Range("AC" & i + 1).Value) = 1 Then
Br.Range("C4") = Br.Range("C4").Value + 1
End If
End If
Next i
End Sub
'''
I could not test if the program is doing porecisely what you need because I do not know precisely your data in the columns and what you expect, but this code could work properly in my opinion (every variables seem to be correctly read) :
Sub CountHSEcards()
Dim Sh, Br As Worksheet
Set Sh = Sheets("Planilha1")
Set Br = Sheets("Brazil")
NultimaCelula = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
For i = 1 To NultimaCelula
Sh.Select
If InStr(Range(CStr("AD" & i + 1)).Value, "") > 0 Then
If Month(Sh.Range(CStr("C" & i + 1)).Value) = i Then
Br.Range(CStr("C" & i + 3)) = Br.Range(CStr("C" & i + 3)).Value + 1
End If
End If
Next i
End Sub
You chose a notation for the range of a string type. So "AD" for example is OK. However, after you had directly an integer (i or i + x) to this string. It is problematic because it is a mix between different type. You can do like that, but after you convert the overall operation as a string (with CStr). Thus, the range has a string as argument and the address is ok.
Cheers
Thanks guys, with the help of the comments, the code worked well
Sub CountHSEcards()
Dim Sh As Worksheet
Dim Br As Worksheet
Set Sh = Sheets("Banco De Dados")
Set Br = Sheets("Brasil")
Dim z As Integer
Dim h As Integer
NultimaCelula = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
Br.Range("C4" & ":C1000") = Empty
z = 17
h = 16
For i = 1 To NultimaCelula
For x = 1 To 12
If InStr(Sh.Range(CStr("AD" & i + 1)).Value, "Andrea Ramos") > 0 Then
If Month(Sh.Range("C" & i + 1).Value) = x Then
Br.Range("C" & x + 3) = Br.Range("C" & x + 3).Value + 1
Br.Range("C16").FormulaLocal = WorksheetFunction.Sum(Range("C4:C15"))
End If
End If
Next x
Next i
End Sub
I am trying to fill out a table by summing the first "x" number of values then the next "x" number of values.
Essentially this:
=SUM(Ax:Ay) where x and y are the row numbers
Sheets(1).Range("B"+i).Formula = "=SUM(A" & x & ":A" & y & ")"
Here is what my actual code looks like:
Private Sub ScrollBar1_Change()
Application.ScreenUpdating = False
Dim slider_val As Long
Dim output_tbl As ListObject
Dim data_tbl As ListObject
Dim i As Long
Dim j As Long
Dim start As Long
Dim finish As Long
Set data_tbl = Sheets("Data").ListObjects("DataTable")
Set output_tbl = Sheets("Slider").ListObjects("OutputTable")
slider_val = Sheets("Slider").Range("A5").Value
start = 2
For i = 1 To 12
finish = start + slider_val
Sheets("Slider").Range("B" & j).Formula = "=SUM(Data!K" & start & ":K" & finish & ")"
j = j + 1
start = finish + 1
Next i
Application.ScreenUpdating = True
End Sub
I get the error "Application-defined or object-defined error" when I try to run this code.
Thank you all for your help, the problem was that I had not defined "j" yet.
Trying to set the variable names in a way that allows looping the code without having to type out an instance of each 'directory'.
The intent of this code is to count how many files are in each directory.
Code I have so far (doesn't work):
Sub CountFiles()
Dim xFolder() As Long
Dim xPath() As Long
Dim xCount() As Long
Dim xFile() As String
Dim z As Long
xFolder(1) = "\\generic path"
xFolder(2) = "\\generic path2"
For z = 1 To 2
xPath(z) = xFolder(z) & "\*.xlsx"
xFile(z) = Dir(xPath(z))
Do While xFile(z) <> ""
xCount(z) = xCount(z) + 1
xFile(z) = Dir()
Loop
With Worksheets("test")
.Cells(3, 2).value = xCount(z)
End With
Next z
End Sub
If I don't use the looping method, I can just set the variables to be xFolder1, xFolder2, xFolder3 etc., but then I'd have to run an instance of the code which loops through the directories to count for each iteration.
Is there a way to do this? Thanks.
Define all the following as String array, in your case you want each array to have 2 elements.
Dim xFolder(1 To 2) As String
Dim xPath(1 To 2) As String
Dim xCount(1 To 2) As Long
Dim xFile(1 To 2) As String
Thanks for the answers and explanations surrounding types/arrays. Added the y variable to advance the output columns by 1 each time.
Final working code:
Sub CountFiles()
Dim xFolder(1 To 2) As String
Dim xPath(1 To 2) As String
Dim xCount(1 To 2) As Long
Dim xFile(1 To 2) As String
Dim z As Long
Dim y As Long
xFolder(1) = "\\generic path"
xFolder(2) = "\\generic path2"
For z = 1 To 2
xPath(z) = xFolder(z) & "\*.xlsx"
xFile(z) = Dir(xPath(z))
Do While xFile(z) <> ""
xCount(z) = xCount(z) + 1
xFile(z) = Dir()
Loop
y = z + 1
With Worksheets("test")
.Cells(3, y).value = xCount(z)
End With
y = 0
Next z
End Sub
Looking to adjust the code below from copying an entire row to a static range of rows (ie: A:Q)
Sub CopyRows()
Dim bottomL As Integer
Dim x As Integer
bottomL = Sheets("Pacer").Range("L" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Raw Data").Range("A1:L" & bottomL)
If (c.Value = "Group1" Or c.Value = "Group2" Or c.Value = "Group3") Then
c.EntireRow.Copy Worksheets("Formatted Data").Range("A" & x + 1)
x = x + 1
End If
Next c
End Sub
Might be easiest to use Intersect.
intersect(c.parent.columns("A:Q"), c.EntireRow).Copy Worksheets("Formatted Data").Range("A" & x + 1)
I'm building an master excel file that is designed to gather data from lots of other excel files that are stored in the business Dropbox files and place them in the 2nd sheet of the master file. I built a original version on my local computer and that worked perfectly (the path3 variable) but once I tried to convert it based on a changing file path (because each user will have a different path from their PC) I am getting the run time error. The formula defined by path2 is what I have been trying to use but even though the variable seems to be holding the right value (I tested it by having it write out the values) it doesn't seem to be able to move the data, throwing the above error and highlighting the "rngdest.Formula = Chr(61) & path2" line. I really don't have any idea what is causing this and I have spent several days trying different approaches but to no avail so any ideas, solutions or links to already solved (I have spent a long time searching but haven't found anything) would be very much appreciated.
I've included the whole of the code for completeness, I think I've removed most of the redundant code that I left in but there may be some still left. If you need any clarifications on the code please let me know. Thanks for any potential help
Private Sub CommandButton2_Click()
Dim counter As Integer
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim a As Integer
Dim z As Integer
Dim y As Integer
Dim p As Integer
Dim Names() As String
Dim Fix1() As String
Dim path3 As String
Dim path2 As String
Dim SheetName As String
Dim c As Range
Dim found As Range
Dim BookName As String
Dim var1 As String
Dim rngdest As Range
Dim rngsource As Range
Dim cell As String
Dim adjust As Integer
Dim adjust2 As Integer
Dim rngname As Range
Dim colNo As Integer
Dim fin As String
Dim fin2 As String
Dim fin3 As String
Dim comp As String
Dim teststring As String
Dim currentWb2 As Workbook
Set currentWb2 = ThisWorkbook
MsgBox "Excel will now update the sheet, please be patient as this can take a few minutes. You will be notified once it is complete"
ReDim Fix1(1 To 4)
Fix1(1) = "A-F"
Fix1(2) = "G-L"
Fix1(3) = "M-R"
Fix1(4) = "S-Z"
counter = 0
With ActiveSheet
i = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
ReDim Names(1 To i, 1 To 4)
With ActiveSheet
For k = 1 To 4
For a = 2 To i
Names(a, k) = Cells(a, k).Value
Next a
Next k
End With
SheetName = "Analysis"
BookName = "Outcomes Final.xlsm"
For p = 1 To 4
fin2 = Split(Cells(, p).Address, "$")(1)
With ActiveSheet
l = .Cells(.Rows.Count, fin2).End(xlUp).Row
End With
For z = 1 To l
counter = counter + 1
fin = Split(Cells(, counter).Address, "$")(1)
currentWb2.Sheets("Sheet2").Range("" & fin & "1") = Names(z, p)
For y = 1 To 34
adjust = y + 1
cell = "$B$" & y & ""
If z = 1 Then
Else
teststring = GetPath()
teststring = teststring & "\Clients\"
path3 = "'C:\Users\Lewis\Documents\Outcomes\Floating Support\Clients\" & Fix1(p) & "\" & Names(z, p) & "\[Outcomes Final.xlsm]Analysis'!" & cell & ""
path2 = teststring & Fix1(p) & "\" & Names(z, p) & "\Outcomes\[Outcomes Final.xlsm]Analysis'!" & cell & ""
End If
Set rngdest = currentWb2.Sheets("Sheet2").Range("" & fin & "" & adjust & "")
Set rngsource = Range("B" & y & "")
rngdest.Formula = Chr(61) & path2
Next y
Next z
Next p
currentWb2.Sheets("Sheet2").Columns(1).EntireColumn.Delete
currentWb2.Sheets("Sheet1").Range("A1:D35").Interior.ColorIndex = 0
For j = 1 To counter
fin3 = Split(Cells(, j).Address, "$")(1)
If currentWb2.Sheets("Sheet2").Range("" & fin3 & "35") = "1" Then
With currentWb2.Sheets("Sheet1").Range("A1:D35")
comp = currentWb2.Sheets("Sheet2").Range("" & fin3 & "1")
Set c = .Find(comp, LookIn:=xlValues)
If Not c Is Nothing Then
c.Interior.ColorIndex = 3
End If
End With
End If
Next j
MsgBox "The update is now complete, please click on sheet 2 to view the data. All clients in red have not been properly completed"
End Sub