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.
Related
I am working with a Powder Flow Tester at a research company (outputs data in excel format) and need a way to summarize the data from ~2000 files [in one folder] in one excel spreadsheet. I'd like 6 pieces of data from each file. The data is in the same spot in each spreadsheet. I have tried the following, but they are too user intensive to be practical.
1) =SUM('C:\Users\MYUSER\Desktop\PFTData[PSFChoc.XLS]0001'!$K$26)
poor because I need to change the file name manually for each file and need to change the cell accessed for each of the six data pieces I need.
2) =INDIRECT("'" & $K$3 & "'[" & A12 & "]" & $K$2 & "'!" & $K$1)
poor because each file needs to be open for INDIRECT to work. Computer will not handle that well. Same problem as the original formula too.
3) Tried to use the Index function, but also needed to change the file name manually for each one.
Is there a formula that can create an array of each file name and access the six data pieces from each file? I am open to VBA solutions, but I have zero experience with VBA.
This should get you started.
Note there are two approaches to extracting the data:
ExecuteExcel4Macro: this is probably best if you know the worksheet names are all the same
Formula-based version: as long as the source files only have a single sheet, then this will work regardless of the sheet names.
Which one you use will depend on your exact use case.
Sub ExtractData()
Const F_PATH As String = "C:\_Stuff\test\files\"
Dim f, sht As Worksheet, arrRefs, rw As Long, cl As Long, ref
Set sht = ThisWorkbook.Sheets("Data")
arrRefs = Array("$A$1", "$B$2", "$C$3") 'cells to extract
rw = 2 'starting row for data
f = Dir(F_PATH & "*.xls*")
Do While f <> ""
sht.Cells(rw, 1).Value = f 'record the filename
cl = 2 '<< starting column for extracted data
For Each ref In arrRefs
'## use this form if the worksheets all have the same name
'sht.Cells(rw, cl) = ExecuteExcel4Macro("'" & F_PATH & "[" & f & _
' "]Sheet1'!" & Range(ref).Address(True, True, -xlR1C1))
'## use this form if the worksheet names might vary
'*** as long as there's only one worksheet in each file**
With sht.Cells(rw, cl)
.Formula = "='" & F_PATH & "[" & f & "]blah'!" & ref
.Value = .Value
End With
cl = cl + 1 '<< next column
Next ref
rw = rw + 1
f = Dir() '<< next file
Loop
End Sub
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
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.
I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.
This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.
This program is to convert a column of data from cumulative to non-cumulative. On my sheet I have A1, B1, and C1 with the text Non-Cumulative, Cumulative, and Converted, respectively. I have numbers 1 to 10 beneath A1, then them summed cumulatively beneath B1. C1 is where I want to convert column B back to non-cumulative.
The IsNumeric is used to make the first row of data in C equal to the first row of data in B. It should detect that the title is above the number it is evaluating, thus knowing that no calculations have to be performed. For the rest of them, it'll see that the number above the one it is evaluating is a number, and thus the calculation has to be done.
My problem is that it isn't working. I think the reason is because IsNumeric() keeps coming back as false. Is there a different function I should be using? Do cell references not work in IsNumeric?
Here's the program!
Option Explicit
Dim i As Variant
Sub Conversion()
Sheets("Test Sheet").Select
For i = 1 To 10
If IsNumeric("B" & i) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next
End Sub
The way you wrote your code is logical, just a minor syntax changes you need initially. However,
It's also best to check if the range is empty first...
Then check on if the value is numeric.
Better even, if you set the Range into a Range object and use offset
Code:
Option Explicit '-- great that you use explicit declaration :)
Sub Conversion()
Dim i As Integer '-- integer is good enough
Dim rngRange as Range
'-- try not to select anything. And for a cleaner code
Set rngRange = Sheets("Test Sheet").Range("B1")
For i = 1 To 10
If (rangeRange.Offset(i,0).value) <> "" then '-- check for non-empty
If IsNumeric(rangeRange.Offset(i,0).value) = False Then
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0)
Else
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0) - rangeRange.Offset(i-1,0)
End If
End if
Next i '-- loop
End Sub
To make your code more dynamic:
Another suggestion, you may simply Application.WorkSheetFunction.Transpose() the entire B column range that you need to validate into a variant array
Process the array and Transpose back to the Range with column B and C.
By doing so, you may omit setting for loop size manually but setting it using Lower and Upper bound of the array ;)
You need to check if the range of B i is numeric, not the string "B" & i
and rather than selecting the sheet, simply using a parent identifier like:
sheets("sheet1").range("B" & i)
This will help you avoid errors in your code
For i = 1 To 10
If IsNumeric(sheets("test sheet").range("B" & i).value) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next