Here is all the applicable code that I'm having a hard time with (though part of a large program). I'm making an executive dashboard, and this data rolls up into a chart on a separate sheet looking at month-over-month utility usage. It is supposed to copy over a variable number of utilities from a variable number of months.
Integer m is the months (I'm using 3/March as my example), so from i=1 to 3 it's supposed to copy/paste the rows from the ns that is opened into ws. It keeps giving an error 1004, so I think I'm calling my ranges incorrectly, but I'm not sure how/why. In my code, the error is down in that For Loop, none of the lines seem to work
I need some sort of variable so that I can later roll it up into my chart. Here are some photos of what's supposed to come over (only the headers are coming over, which wasn't using the .Cell(). Also, if anyone knows the correct way to code my second to last line, please share (though not my primary challenge).
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select Trend Income Statement for " & os.Range("B2") & " " & os.Range("B3"))
If fNameAndPath = False Then Exit Sub
'We are opening and pulling data from the selected workbook, so lets turn off screen updating and get to work
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set nb = Workbooks.Open(fNameAndPath)
Set ns = nb.Sheets(1)
m = Month(ws.Range("B1"))
'Build out the Utility Section
Let FindIt = "50100-000"
Set FoundCell = ns.Range("A:A").Find(What:=FindIt)
fRow = FoundCell.Row + 1 'This will be the first Util GL
Let FindIt2 = "50199-999"
Set FoundCell2 = ns.Range("A:A").Find(What:=FindIt2)
fRow2 = FoundCell2.Row - 1 ' This will be the last Util GL
ns.Range("B" & fRow - 1 & ":B" & fRow2 + 1).Copy 'Copy the header range
ws.Range("G16").PasteSpecial Paste:=xlPasteValues
For i = 1 To m
Set cRange = ns.Range(ns.Cells(fRow, 2 + i), ns.Cells(fRow2, 2 + i))
ns.Range(cRange).Copy
Set pRange = ws.Range(ws.Cells(17, 7 + i))
ws.Range(pRange).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(15, 7 + i)).Formula = "=TEXT(i*30, mmmmm)"
Next i
I had trouble getting several parts of your code to work as it seems to be a snippet of a larger program.
I think what might be causing your issue is that you are using one Cells() in some of your Range() calls. The Range() call returns a 1004 error when I tried providing it with only one Cells() object.
For example you use
'This throws 1004 error
ws.Range(ws.Cells(17 , 7 + i ))
Try to use something like this
ws.Cells(17 , 7 + i)
Also, you can use something like this
ws.Range("G17").Offset(0,i)
See if any of these works for your use case and produces the desired result.
Related
I have an Excel report. This report has many, many different types on it. (A, B, C, D, etc.). I'd only like a few of these types - Let's say A and B. The actuality is much larger, otherwise I'd use an autofilter. I'm trying to move A and B from the first workbook to the second workbook, and leave the rest alone. Here's what I have so far:
Sub ConditionalMoving ()
Workbooks.Open Filename:=MSCReportPath
Set MSCReport = ActiveWorkbook
Workbooks.Open Filename:=CABReportPath
Set CABReport = ActiveWorkbook
Set MSTab = MSCReport.Sheets(1)
LastRowMSC = MSTab.Range("A" & Rows.Count).End(xlUp).Row
i = 1
j = 1
For i = i To i = WorksheetFunction.CountA(MSTab.Range("A1:A" & LastRowMSC))
If IsNumeric(WorksheetFunction.Match(MSTab.Range("E" & i), Range("MSCFundList"), 0)) Then
Set RngMSC = MSTab.Range("A" & i & ":AZ" & i
CabReport.Sheets("MS").Range("B" & j & ":BA" & j).Value = RngMSC.Value
j = j + 1
End If
Next I
End sub
And it runs no problem. At the end, I have a large block highlighted on my destination sheet - with no text at all. The size of the highlighted block is roughly what I'd expect to come through.
Am I making any obvious mistakes? I've seen some things with arrays floating around, is there a better way to do this with an array? How would you find the needed parts and move them over?
No error messages are generated.
I partially solved the problem that I initially had and figured that my description of the problem was a bit too detailed. I decided to rewrite my question so it's easier to understand the problem and people who are looking for the same thing can relate faster.
I've got several topic files (each with a different name) with 21 rows and 21 columns that need to be gathered into 1 file (called Summary). In Summary, I want a code that looks at a list of the topic names and then places a reference in the cells to the corresponding cells in the topic file. As you can see in the code below, I've accomplished a simplified version of this. It looks at the cell with the name of the first topic file and then created a reference for all rows and columns in that file.
Sub PullValue()
Dim path, file, sheet
Dim i As Integer, j As Integer
Application.ScreenUpdating = False
path = Worksheets("Settings").Range("B23")
file = Worksheets("Consolidation").Range("A1")
sheet = "Overview"
For i = 2 To 22
For j = 1 To 21
Cells(i, j).Formula = "='" & path & "[" & file & ".xlsm]" & _
sheet & "'!" & Cells(i - 1, j).Address & ""
Next j
Next i
Application.ScreenUpdating = True
End Sub
This works as it should, but after that, it has to do this for all the files in that topic name table. I'll keep on trying, but help would be much appreciated, thanks.
If more info is required, don't hesitate to ask.
Thanks!
Bart
After a lot of research and trial & error, I came up with my own solution. I'll share it here so people who are dealing with the same issue can get some input here.
I've added comments to the code so it's easier to understand.
Sub PullValue()
Dim path, file, sheet
Dim LastRow As Long, TopicCount As Long
Dim i As Integer, j As Integer, a As Integer
Application.ScreenUpdating = False
'1. We count how many topics are written in the Topics table to decide the amount of loops
'I do this by checking the total rows in the table and subtract the empty ones
With Worksheets("Settings").ListObjects("Topics")
TopicCount = .DataBodyRange.Rows.Count - _
Application.CountBlank(.DataBodyRange)
End With
'2. We loop the code for the amount of times we just calculated so it does it for all topics
'I'll make a note where we can find that a in the code
For a = 1 To TopicCount
'3. In the consolidation sheet where all the data will be, we want to check what the
'LastRow is in column A to get the starting point of where the data is entered
With Worksheets("Consolidation")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'4. This If function puts a spacing between the blocks of data if the LastRow is not the
'first row. This is only to make it visually look better.
If LastRow <> 1 Then
LastRow = LastRow + 2
End If
'5. The first thing we want to do is put the name of the topic below the LastRow so it's
'easy to check afterwards what topic the block of data belongs to. Here you can find the
'a from the loop we have in the beginning.
Cells(LastRow, "A").Value = [Topics].Cells(a, [Topics[Topics]].Column)
'6. Locate where the path, file and sheet names are located in the document. Don't
'forget to put the / at the end if it's a website or the \ if it's on your computer.
'If you look to the code at comment number 7, we already have the .xlsm in the formula
'so we don't need to enter that for the file.
path = Worksheets("Settings").Range("D2")
file = Worksheets("Consolidation").Cells(LastRow, 1)
sheet = "Overview"
'This is the core of the code and will the right reference in the right cell. This loops
'for all the 21 rows and columns.
For i = LastRow + 1 To LastRow + 21
For j = 1 To 21
Cells(i, j).Formula = "='" & path & "[" & file & ".xlsm]" & _
sheet & "'!" & Cells(i - LastRow, j).Address & ""
Next j
Next i
Next a
Application.ScreenUpdating = True
End Sub
Any questions you might have regarding the code, let me know. I hope this might help some people. Improvements are of course welcome as well.
Bart
Developing a large macro and now it seems the second simplest part is giving me trouble.
I am able to copy the selection in one workbook, but it does not allow me to paste over to the other workbook. I am getting:
"Object doesn't support this property or method" error.
This is looping through large sets of data so it will need to be able to rinse and repeat, which shouldn't be a problem because I can just clear the clipboard as a rinse method.
Any ideas?
Code below. There is code above it, but I don't think you should need any of it to get an idea of what's going on. Error comes in on the ** line.
Do
DoEvents
'Tests condition for counter party
If InStr(1, Range(buyerCol & row_counter), clientName) > 0 Or InStr(1, Range(sellerCol & row_counter), clientName) > 0 Then
EEB.Sheets("Trades Master List").Rows(row_counter).Copy
'Activates newly created excel sheet
Workbooks(newWorkbookName).Activate
'Tests newly created sheet for already existing entries and increments newSheetRow by 1 until it finds the next empty space
Do While IsEmpty(Range("A" & newSheetRow)) = False
newSheetRow = newSheetRow + 1
Loop
**ActiveWorkbook.Range(newSheetRow & newSheetRow).PasteSpecial
EEB.masterList.Activate
row_counter = row_counter + 1
Else
row_counter = row_counter + 1
End If
Loop Until Range("A" & row_counter).Value > endDateFromSheet Or IsEmpty(Range("A" & row_counter)) = True
Rewriting this for clarity, I think the original was too confusing and too long.
I'm trying to grab contiguous time series data off a sheet named "Files", process it through a series of calculations on a sheet named "Data", copy those results and paste them as static data in a non-contiguous range on "Data" and then repeating that process until all data has been handled.
The issue I've been struggling with for the last five days is the placement of the second function. If I nest it inside of "i" it writes each single result 25 times to the non-contiguous range. If I place it outside of "i" it finishes "i" then writes only the last result to each of the 25 locations.
I'm pretty sure at this point I'm using the wrong structure, I'm guessing a "For" loop isn't the way to go for the second function, but I'm so new to this I can't really get my head wrapped around how to implement it otherwise. I've also tried to structure "n" as an array but was never able to get that debugged and wasn't sure it was the right approach either.
Sub getData()
' Process individual time series
Dim Data As Worksheet, Files As Worksheet
Dim fLastRow As Long, dLastRow As Long
Dim i As Long, n As Long
Application.ScreenUpdating = False
Set Data = ActiveWorkbook.Sheets("Data")
Set Files = ActiveWorkbook.Sheets("Files")
fLastRow = Files.Range("A" & Files.Rows.Count).End(xlUp).Row
dLastRow = Data.Range("F" & Data.Rows.Count).End(xlUp).Row
' Process three column data
Files.Range("A1:C" & fLastRow).Copy
Data.Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
Data.Range("F202:P" & dLastRow).Copy
Data.Range("T202").PasteSpecial xlPasteValuesAndNumberFormats
' Process single column data
For i = 4 To 26
Files.Activate
Range(Cells(1, i), Cells(3509, i)).Copy
Data.Range("C3").PasteSpecial xlPasteValuesAndNumberFormats
Data.Range("F202:P" & dLastRow).Copy
For n = 32 To 296 Step 12 ' <~~ this is the problem. inside or outside "i" doesn't work.
Data.Activate
Range(Cells(202, n), Cells(3511, n)).PasteSpecial xlPasteValuesAndNumberFormats
Next n ' <~~ i know this is the problem just not sure what the answer is.
Next i
' Post processing
Data.Cells.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
Data.Activate
Data.Range("A1").Select
End Sub
You could use one variable; n. Continue stepping by 12, but where you want to place the i variable, use n and divide by 12 and add 4
Until I get better at the code I'll have to settle for this... I stepped the data on the "files" sheet to coincide with the step on the data sheet. To keep the data readable on the "files" tab I just hid the added columns. This allowed me to use "i" for both copy paste operations. I'm sure there is a better way but this meets my needs and is much faster than the original code I started with.
Sub getData()
' Process individual time series
Dim Data As Worksheet, Files As Worksheet
Dim fLastRow As Long, dLastRow As Long, i As Long
Set Data = ActiveWorkbook.Sheets("Data")
Set Files = ActiveWorkbook.Sheets("Files")
fLastRow = Files.Range("A" & Files.Rows.Count).End(xlUp).Row
dLastRow = Data.Range("F" & Data.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
' Process data
Files.Range("A1:C" & fLastRow).Copy
Data.Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
Data.Range("F202:P" & dLastRow).Copy
Data.Range("T202").PasteSpecial xlPasteValuesAndNumberFormats
Files.Range("D1:JH" & fLastRow).Copy
Data.Range("AF3520").PasteSpecial xlPasteValuesAndNumberFormats
For i = 32 To 296 Step 12
Data.Range(Cells(3520, i), Cells(7103, i)).Copy
Data.Range("C3").PasteSpecial xlPasteValuesAndNumberFormats
Data.Range("F202:P" & dLastRow).Copy
Data.Range(Cells(202, i), Cells(3511, i)).PasteSpecial xlPasteValuesAndNumberFormats
Next i
' Post processing
Data.Range(Cells(3520, 32), Cells(7103, 296)).ClearContents
Data.Cells.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A1").Select
End Sub
I'm trying to run a macro that will delete rows that don't contain a particular value in column B. Here's my code:
Sub deleteRows()
Dim count As Integer
count = Application.WorksheetFunction.CountA(Range("AF:AF"))
Dim i As Integer
i = 21
Do While i <= count
If (Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search("OSR Platform", Range("B" & i))) = False) Then
If (Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search("IAM", Range("B" & i))) = False) Then
Rows(i).EntireRow.Delete
i = i - 1
count = count - 1
End If
End If
i = i + 1
Loop
End Sub
Now what it SHOULD be doing is the following:
1.) Find the number of rows to go through and set that as count (this works)
2.) Start at row 21 and look for "OSR Platform" and "IAM" in column B [this kind of works (see below)]
3.) If it finds neither, delete the entire row and adjust the count and row number as necessary (this works)
For some reason, whenever the code gets to the first If statement, an error window with a red X pops up that just says "400." As far as I can tell, I have written everything syntactically soundly, but clearly there's something wrong.
You may want to start by looping the other way. When you delete a line, all the previous lines are shifted. You account for this, but a reverse loop is simpler (for me anyways) to understand than keeping track of when I've offset the current position within the loop:
For i = count To 21 Step -1
Also, you're relying too much on Application.WorksheetFunction:
(Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search("OSR Platform", Range("B" & i))) = False)
to
InStr(Range("B" & i).value, "OSR Platform") > 0
Application.WorksheetFunction takes much more processing power, and depending on what you are trying to accomplish, this can take a significantly longer amount of time. Also for this suggested change, the code size is reduced and becomes easier to read without it.
Your count can also be obtained without A.WF:
Excel 2000/03: count = Range("AF65536").End(xlUp).Row
Excel 2007/10: count = Range("AF1048576").End(xlUp).Row
Version independent: count = Range("AF" & Rows.Count).End(xlUp).Row
One more thing is that you can do (and should do in this case) is combine your If statements into one.
Making these changes, you end up with:
Sub deleteRows()
Dim count As Integer
count = Range("AF" & Rows.Count).End(xlUp).Row
Dim i As Integer
For i = count To 21 Step -1
If Len(Range("B" & i).value) > 0 Then
If InStr(Range("B" & i).value, "OSR Platform") > 0 Or InStr(Range("B" & i).value, "IAM") > 0 Then
Range("B" & i).Interior.Color = RGB(255, 0, 0)
End If
End If
Next i
End Sub
If this does not help, then can you step through the code line by line. Add a breakpoint, and step through with F8. Highlight the variables in your code, right-click, choose "add Watch...", click "OK", (Here's an excellent resource to help you with your debugging in general) and note the following:
Which line hits the error?
What is the value of i and count when that happens? (add a watch on these variables to help)
This worked for me. It uses AutoFilter, does not require looping or worksheet functions.
Sub DeleteRows()
Dim currentSheet As Excel.Worksheet
Dim rngfilter As Excel.Range
Dim lastrow As Long, lastcolumn As Long
Set currentSheet = ActiveSheet
' get range
lastrow = currentSheet.Cells(Excel.Rows.Count, "AF").End(xlUp).Row
lastcolumn = currentSheet.Cells(1, Excel.Columns.Count).End(xlToLeft).Column
Set rngfilter = currentSheet.Range("A1", currentSheet.Cells(lastrow, lastcolumn))
' filter by column B criteria
rngfilter.AutoFilter Field:=2, Criteria1:="<>*OSR Platform*", Operator:= _
xlAnd, Criteria2:="<>*IAM*"
' delete any visible row greater than row 21 which does not meet above criteria
rngfilter.Offset(21).SpecialCells(xlCellTypeVisible).EntireRow.Delete
' remove autofilter arrows
currentSheet.AutoFilterMode = False
End Sub
This code applies AutoFilter to column B to see which rows contain neither "OSR Platform" nor "IAM" in column B. Then it simply deletes the remaining rows greater than 21. Test it on a copy of your workbook first.
With a huge nod to this OzGrid thread, because I can never remember the proper syntax for selecting visible cells after filtering.