I made the following Sub to help me copy values from other workbooks or even just from other sheets within the same workbook.
Private Sub CopyValues(fromSheet As String, fromRange As String, toSheet As String, toRange As String, Optional fromFileName As String = "")
Dim toFile As Excel.Workbook
Set toFile = ActiveWorkbook
Dim fromFile As Excel.Workbook
If Len(fromFileName) > 0 Then
Set fromFile = Workbooks.Open(fromFileName)
Else
Set fromFile = ActiveWorkbook
End If
With ActiveWorkbook
toFile.Sheets(toSheet).Range(toRange).Value = fromFile.Sheets(fromSheet).Range(fromRange).Value
End With
If Len(fromFileName) > 0 Then
fromFile.Close savechanges:=False
End If
End Sub
It works pretty well (and you all are free to use it if you find it helpful). Below is an example of code that works:
Call CopyValues(reportName, "B4:C15", reportName, "E2:F13", reportDirPath)
Unfortunately, I'm having trouble with a specific case. I'm looking to copy the same value into multiple cells in the same column. Below is what I came up with:
For i = 2 To i = 13
Call CopyValues(reportName, "AJ2", reportName, "H" + i, reportDirPath)
Next i
That didn't work. No error messages, but none of the values were pasted into my sheet. I thought that maybe concatenating the integer i was converting (is that the technical word?) the string to a different type, so I tried the following:
For i = 2 To i = 13
Call CopyValues(reportName, "AJ2", reportName, CStr("H" + i), reportDirPath)
Next i
That still didn't work. Same deal. No error messages, but none of the values were pasted into my sheet.
Changing the + to an & also didn't work:
For i = 2 To i = 13
Call CopyValues(reportName, "AJ2", reportName, CStr("H" & i), reportDirPath)
Next i
Obviously, I could just write out each individual case, but that seems kind of ridiculous. Any idea what's going on?
When I tried your code your 'For' loops were not working, but after I changed your for loop to say 'For i = 2 to 13' as opposed to 'For i=2 To i = 13' the last version of your code worked for me.
For i = 2 To 13
Call CopyValues("Sheet1", "A1", "Sheet2", CStr("J" & i))
Next i
End Sub
So I think that could have been your trouble.
Related
I don't know if I explained this too well. I'm a beginner and I'm trying to get a value from a file using VLOOKUP in VBA. However, even though I can apparently work with the string itself, I cannot use it as a variable.
So, the idea is to automatically populate two text boxes when I select something in the dropdown. The dropwdown itself determines the Worksheet that has the data.
Private Sub cbProductList1_Change()
vCode1 = Application.WorksheetFunction.VLookup(cbProductList1.Value,
[Products!A:B], 2, False)
Me.tbProdCode1 = vCode1
vPrice1 = Evaluate("VLOOKUP(" & vCode1 & ", " & Me.labelCFValue & ", 2, False)")
Me.tbPrice1 = vPrice1
End Sub
If I run a MsgBox on vCode1 - it gives me the string that needs to be the first argument for VLOOKUP.
If I run a MsgBox on Me.labelCFValue it gives me CF_1!A25:B33 (without the quotes) just as I need it to do. But when I run MsgBox on vPrice1, I get an error.
Later Edit: Alternatively, if you could help me use Me.labelCFValue inside Application.WorksheetFunction.VLookup(), that could also be good.
Please help?
I was unable to test the code but believe that this should either work or help you find your way.
Option Explicit
Private Sub cbProductList1_Change()
Dim Rl As Long ' last row
Dim LookupRange As Range
Dim Sp() As String ' splitting labelCFValue
Dim vCode1 As String
Dim vPrice1 As Double
' ActiveSheet is the default, but better to declare
With ActiveSheet
Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
Set LookupRange = .Range(.Cells(1, 1), Cells(Rl, 2))
End With
vCode1 = Application.VLookup(cbProductList1.Value, LookupRange, 2, False)
Me.tbProdCode1 = vCode1
' If Me.labelCFValue is a Label, the string should be its Caption property.
' If it is a Textbox the string should be its Value or Text property.
' Either way, it is better to specify what you are addressing:-
Sp = Split(Me.labelCFValue, "!")
Set LookupRange = Worksheets(Sp(0)).Range(Sp(1))
vPrice1 = Evaluate(Application.VLookup(vCode1, LookupRange, 2, False))
Me.tbPrice1 = vPrice1
End Sub
Consider adding some precautionary code to deal with the possibility that either of the Vlookups return an error.
I'm attempting to take the text in each cell of column A and assign a value to each cell in column B depending on the text in column A. For example, I have a list of versions that are identified by four-letter abbreviations of cities, and all of those versions are regionally assigned to different factories to be produced. So let's say I have an "AUST", "DAFW", "HOUS", and more versions all assigned to the location of "ARLINGTON". How would I most concisely use VBA to automate that once I have all the versions plugged in? Something like
If A2="AUST" Then
B2="ARLINGTON"
ElseIf A2="DAFW" Then
B2="ARLINGTON"
I suppose something like this would work, however I can't believe that there's not a faster and more concise way. Does this make any sense? I've been pulling my hair out for about a week now trying to figure this out... Thanks for any help!
This is a little simpler using OR:
If A2="AUST" OR A2="DAFW" Then
B2="ARLINGTON"
ElseIf A2 = "ABCD" OR A2 = "WZYZ" Then
B2="SOMETHING"
'ETC...
However, if you are iterating over column A, the variable "A2" is strange. But I am not sure how you are doing this. Maybe supply more code and we can help you more.
This could be done with excel formulas as well, though I always prefer to use VBA. This should work the way you want :
Sub yourFunk()
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
arlington = Array("AUST", "DAFW", "HOUS")
otherLocation = Array("XXXX", "YYYY", "ZZZZ")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For x = 2 To lastRow
If stringIsInArray(ws.Cells(x, 1), arlington) Then
ws.Cells(x, 2) = "ARLINGTON"
ElseIf stringIsInArray(ws.Cells(x, 1), otherLocation) Then
ws.Cells(x, 2) = "OTHER LOCATION"
End If
Next x
End Sub
Function stringIsInArray(stringToBeFound As String, arr As Variant) As Boolean
stringIsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
If you need me to explain the code, please do let me know :)
The fastest way is to use Dictionary.
Let's say, your data is present in the following range:
A2 = "AUST"
A3 = "DAFW"
Now, check this code:
'Needs reference to Microsoft Scripting Runtime
Sub Translate()
Dim dic As Dictionary
Dim i As Integer, sTmp As String
Set dic = New Dictionary
dic.Add "AUST", "ARLINGTON"
dic.Add "DAFW", "ARLINGTON"
For i = 2 To 3
sTmp = ThisWorkbook.Worksheets(1).Range("A" & i)
Debug.Print sTmp, "-", dic(sTmp)
Next
Set dic = Nothing
End Sub
Note: This code is just an example!
For further information please see: https://msdn.microsoft.com/en-us/library/office/gg251825.aspx
Hello I am trying to run the following code to count the number of times something appears in a sheet.
Sub test()
' passes in what sheet (Sheet1) to search and which row (5) to write the results
dummy = CountExample("Sheet1", 5)
End Sub
Function CountExample(Sheet As String, RowPopulate As Integer)
Sheets(Sheet).Select ' Selects the appropriate sheet to search through
Dim tmp As Integer
' Search for find1
tmp = Application.WorksheetFunction.CountIf(Cells, "find1")
Sheets("Recording Sheet").Select
Range("C" & RowPopulate).Value = tmp ' Update and write the value in C5
tmp = 0 'this does not seem to do anything
' something wrong with this one find2 should have 39 matches not 15
' Search for find2
tmp = Application.WorksheetFunction.CountIf(Cells, "find2")
Sheets("Recording Sheet").Select
Range("E" & RowPopulate).Value = tmp ' Update and write the value in E5
End Function
When I just run the code to just search for find2 (after removing the code for searching for find1) I get 39 matches which is correct but if I run the code as above I get 15 matches for find2.
I can't seem to figure out why this is happening.
Thanks
The scope of your worksheet/range objects is not correct. A common mistake, and one reason to avoid relying on constructs like Select and Activate methods, unless otherwise explicitly stated, a range object always refers to the ActiveSheet.
Try this instead (edited per Garys suggestion to use a subroutine instead of a function):
Sub test()
' passes in what sheet (Sheet1) to search and which row (5) to write the results
CountExample "Sheet1", 5
End Sub
Sub CountExample(Sheet As String, RowPopulate As Integer)
' Selects the appropriate sheet to search through
Dim tmp As Integer
Dim ws as Worksheet
Dim wsRecord as Worksheet
Set ws = Worksheets(Sheet)
Set wsRecord = Worksheets("Recording Sheet")
' Search for find1
tmp = Application.WorksheetFunction.CountIf(ws.Cells, "find1")
wsRecord.Range("C" & RowPopulate).Value = tmp ' Update and write the value in C5
tmp = 0 'this does not seem to do anything
' something wrong with this one find2 should have 39 matches not 15
' Search for find2
tmp = Application.WorksheetFunction.CountIf(ws.Cells, "find2")
wsRecord.Range("E" & RowPopulate).Value = tmp ' Update and write the value in E5
End Sub
You need a Sub rather than a Function since you want to change a set of cells rather than return a single value
You are using Sheets("Recording Sheet").Select to switch to "Recording Sheet", but you are not switching back to Sheet. So the second CountIf is occurring on "Recording Sheet".
I'm for a solution to part of a macro I'm writing that will hide certain (fixed position) rows across a few different sheets. I currently have:
Sheets(Sheet1).Range("5:20").EntireRow.Hidden = True
To hide rows 5-20 in Sheet1. I also would like to hide (for arguements sake), row 6, row 21, and rows 35-38 in Sheet2 - I could do this by repeating the above line of code 3 more times; but am sure there's a better way of doing this, just as a learning exercise.
Any help much appreciated :)
Chris
Specify a Union of some ranges as follows
With Sheet1
Union(.Range("1:5"), .Rows(7), .Range("A10"), .Cells(12, 1)).EntireRow.Hidden = True
End With
Here is a try:
Sub hideMultiple()
Dim r As Range
Set r = Union(Range("A1"), Range("A3"))
r.EntireRow.Hidden = True
End Sub
But you cannot Union range from several worksheets, so you would have to loop over each worksheet argument.
This is a crude solution: no validation, no unhiding of existing hidden rows, no check that I have a sheet name as first parameter, etc. But it demonstrates a technique that I often find useful.
I load an array with a string of parameters relevant to my current problem and code a simple loop to implement them. Look up the sub and function declarations and read the section on ParamArrays for a variation on this approach.
Option Explicit
Sub HideColumns()
Dim InxPL As Integer
Dim ParamCrnt As String
Dim ParamList() As Variant
Dim SheetNameCrnt As String
ParamList = Array("Sheet1", 1, "5:6", "Sheet2", 9, "27:35")
SheetNameCrnt = ""
For InxPL = LBound(ParamList) To UBound(ParamList)
ParamCrnt = ParamList(InxPL)
If InStr(ParamCrnt, ":") <> 0 Then
' Row range
Sheets(SheetNameCrnt).Range(ParamCrnt).EntireRow.Hidden = True
ElseIf IsNumeric(ParamCrnt) Then
' Single Row
Sheets(SheetNameCrnt).Range(ParamCrnt & ":" & _
ParamCrnt).EntireRow.Hidden = True
Else
' Assume Sheet name
SheetNameCrnt = ParamCrnt
End If
Next
End Sub
I have the following Data in Excel.
CHM0123456 SRM0123:01
CHM0123456 SRM0123:02
CHM0123456 SRM0256:12
CHM0123456 SRM0123:03
CHM0123457 SRM0789:01
CHM0123457 SRM0789:02
CHM0123457 SRM0789:03
CHM0123457 SRM0789:04
What I need to do is pull out all the relevent SRM numbers that relate to a single CHM ref. now I have a formular that will do some thing like this
=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))
however this is a bit untidy and I really want to produce this same using short vb script, do i jsut have to right a loop that will run though and check each row in turn.
For x = 1 to 6555
if Ax = Chm123456
string = string + Bx
else
next
which should give me a final string of
SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03
to use with how i want.
Or is ther a neater way to do this ?
Cheers
Aaron
my current code
For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value
End If
Next
MsgBox (outstring)
End Function
I'm not sure what your definition of 'neat' is, but here is a VBA function that I consider very neat and also flexible and it's lightning fast (10k+ entires with no lag). You pass it the CHM you want to look for, then the range to look in. You can pass a third optional paramater to set how each entry is seperated. So in your case you could write (assuming your list is :
=ListUnique(B2, B2:B6555)
You can also use Char(10) as the third parameter to seperat by line breaks, etc.
Function ListUnique(ByVal search_text As String, _
ByVal cell_range As range, _
Optional seperator As String = ", ") As String
Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
On Error Resume Next
For Each cell In cell_range
If cell.Value = search_text Then
dict.Add cell.Offset(, 1).Value, 1
End If
Next
keys = dict.keys
For i = 0 To UBound(keys)
result = result & (seperator & keys(i))
Next
If Len(result) <> 0 Then
result = Right$(result, (Len(result) - Len(seperator)))
End If
ListUnique = result
Application.ScreenUpdating = True
End Function
How it works: It simple loops through your range looking for the search_string you give it. If it finds it, it adds it to a dictionary object (which will eliminate all dupes). You dump the results in an array then create a string out of them. Technically you can just pass it "B:B" as the search array if you aren't sure where the end of the column is and this function will still work just fine (1/5th of a second for scanning every cell in column B with 1000 unique hits returned).
Another solution would be to do an advancedfilter for Chm123456 and then you could copy those to another range. If you get them in a string array you can use the built-in excel function Join(saString, ",") (only works with string arrays).
Not actual code for you but it points you in a possible direction that can be helpful.
OK, this might be pretty fast for a ton of data. Grabbing the data for each cell takes a ton of time, it is better to grab it all at once. The the unique to paste and then grab the data using
vData=rUnique
where vData is a variant and rUnique is the is the copied cells. This might actually be faster than grabbing each data point point by point (excel internally can copy and paste extremely fast). Another option would be to grab the unique data without having the copy and past happen, here's how:
dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant
set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
vdata=reach
for i=lbound(vdata) to ubound(vdata)
sdata=sdata & vdata(i,1)
next l
next reach
Personally, I would prefer the internal copy paste then you could go through each sheet and then grab the data at the very end (this would be pretty fast, faster than looping through each cell). So going through each sheet.
dim wks as worksheet
for each wks in Activeworkbook.Worksheets
if wks.name <> "CopiedToWorksheet" then
advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
end if
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
sData=sData & ","
next i
The above code should be blazing fast. I don't think you can use Join on a variant, but you could always attempt it, that would make it even faster. You could also try application.worksheetfunctions.contat (or whatever the contatenate function is) to combine the results and then just grab the final result.
On Error Resume Next
wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents