I wrote the following For Loop to copy and paste several ranges from one sheet to another. I used an array. The procedure works fine, but I was looking for a shorter way to do the same.
Dim copyRange(1 To 3) As String
Dim pasteRange(1 To 3) As String
Dim refRange(1 To 3) As String
Dim i As Long
copyRange(1) = "A5"
copyRange(2) = "G5"
copyRange(3) = "H5"
refRange(1) = "A"
refRange(2) = "G"
refRange(3) = "H"
pasteRange(1) = "BE3"
pasteRange(2) = "CA2"
pasteRange(3) = "CD2"
For i = 1 To 3
refApplicantFlow.Range(copyRange(i), refApplicantFlow.Range(refRange(i) & Rows.Count).End(xlUp)).Copy _
calcCalculations.Range(pasteRange(i))
Next i
First of all, I would strongly recommend, to store the references to the cells as hard coded strings in your macro. The moment your workbook's structure is slightly adjusted, your macros will fail/copy the wrong things!
Instead, use named ranges. I.e. click on A5 and assign the name Source_1 or so to it. G5 will become Source_2, H5 Source_1, G5 Target_1, etc.
The use this code:
lngRows = Rows.Count
For i = 1 To 3
Range("Target_"&i).Resize(lngRows).Value = Range("Source_"&i).Resize(lngRows).Value
Next
This way, your macro will still work, even if the workbook structure changes! And your line of code became shorter! ;-)
Your macro is pretty efficient if the intent was to include a loop and arrays. The same thing could be accomplished in 3 lines:
refApplicantFlow.Range("A5", refApplicantFlow.Range("A" & Rows.Count).End(xlUp)).Copy _
calcCalculations.Range("BE3")
refApplicantFlow.Range("G5", refApplicantFlow.Range("G" & Rows.Count).End(xlUp)).Copy _
calcCalculations.Range("CA2")
refApplicantFlow.Range("H5", refApplicantFlow.Range("H" & Rows.Count).End(xlUp)).Copy _
calcCalculations.Range("CD2")
Related
the ones who read this topic, this is my first question at StackOverflow if any mistakes were made by me please forgive me, I would appreciate it if someone helps.
I have a table which is declared 'genTable' as ListObject. In order to insert and get data from each column of the table. I just set ranges like as:
Dim genTable As ListObject
Set genTable = test.ListObjects("hourly_data")
Set u1_NetLoad = genTable.ListColumns("U1 Net Load").DataBodyRange
I used the following code and helped me setting ranges however it did not satisfied me. I want to learn more dynamic method for my knowledge of programming.
For Each word In genTable.HeaderRowRange
i = 1 + i
test.Cells(22 + i, 2).value = "Set " & Replace(CStr(word), " ", "") & _
" = genTable.ListColumns(" & Chr(34) & word & Chr(34) & ").DataBodyRange"
Next
the output of this code is copied to VBA module to set ranges.
Actually, my scripts work pretty well, but I just want to know If can I set ranges more easily and depending on variables. For my case, I typed every single ranges. I tried the 'for each' loop like this but it did not work.
For Each word In genTable.HeaderRowRange
range_name = Replace(CStr(word), " ", "") & "_"
Set range_name = genTable.ListColumns(word).DataBodyRange
Next
The code above does not work, is there anyway to make it works?
Thanks for reading.
I had the same question last week, I did some digging and came up with this.
Fist I define array then reDim with the the lower and upper limits of the array.
Then using the loop, populated each array entry with the sheet and range needed, noting I needed to use the sheet number, not the name, then I could populate the whole array, then proceed with the code:
...
Dim Nbr_Students As Integer
Dim Counter As Integer
Dim i As Integer
Dim Student_Sheets As Variant
Nbr_Students = Sheets("Master Lists").Range("M3").Value - 1
Counter = 15
i = 0
ReDim RngArray(0 To Nbr_Students)
Do While i <= Nbr_Students
Set RngArray(i) = Worksheets(Counter).Range("C141:C157")
Counter = Counter + 1
i = i + 1
Loop
...
Original Post: Link
I am trying to delete multiple columns of a newly created workbook stated in the original workbook.
The columns to be deleted are mentioned in one column and the number of column-sequences may be variable.
So far I tried to go through it with a loop which does not work currently. Furthermore, it's not a good practice, since after deletion the rows shift which makes it hard to name the correct columns up for deletion.
Currently, i am receiving an error in the For-next-loop. The Columns-Statement doesn't seem to work.
For your information: I am fairly new to VBA and programming. If you have any more tips or hints reading my code, please give me a sign, I am very happy to improve my VBA-skills.
Sub CleanPlan()
' Define columns up for deletion as variable array
' Use .Transpose to ensure one-dimensional array
Dim DelCol As Variant
DelCol = Application.Transpose(ThisWorkbook.Sheets("Export").Range("B4:B" & Cells(Rows.Count, 2).End(xlUp).Row))
' Open origin file, save as .xlsx
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Export").Range("B1").Value
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\name22.xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Workbooks.Open Filename:=ThisWorkbook.Path & "\name22.xlsx"
' Delete columns from array
Dim i As Integer
For i = 1 To UBound(DelCol)
Columns("""" & DelCol(i) & """").Delete
Next i
' more code, irrelevant at this point
There must be a better practice to solve this issue. I am very thankful for any tips!
Try replacing you loop with this:
Dim i As Integer
Dim x As Long
Dim holdInt As Long
' refactor array to numbers:
For i = 0 To UBound(sortArray)
sortArray(i) = GetColumnNumber(Replace(Left(sortArray(i),2), ":", ""))
Next i
' sort array
For i = 0 To UBound(DelCol)
For x = UBound(DelCol) To i + 1 Step -1
If DelCol(x) < DelCol(i) Then
holdInt = DelCol(x)
DelCol(x) = DelCol(i)
DelCol(i) = holdInt
End If
Next x
Next i
' delete column from right to left
For i=UBound(DelCol) to 0 step -1
Columns(DelCol(i)).Delete
Next i
'-------------------------------------------------
Function GetColumnNumber(text As String) As Long
Dim r As range
Set r = range(Trim(text) & 1)
GetColumnNumber = r.Column
End Function
This will sort you array of columns' numbers, and then will go from end to start so the shift not affect column numbers.
UPDATE
Added a general idea of function to refactor array from Column letters to Column numbers before sort. You need to update to make some checks whether your column letters cover couple of rows (e.g. "A:B", instead of "A:A") or whether if you have columns further than "ZZ:ZZ".
I'm brand new to using VBA within excel. I'm not even 100% sure on how to insert a module correctly to begin with so this will be a big help.
I've set up a worksheet that randomizes a number between 1 and 100.
B3 =RANDBETWEEN(C6,F6)
I have 13 contestants. Each gets to guess a number. Goal is to be closest to the randomized number. (Guess a number between x & y. Closest wins "The Prize")
Contestants are listed in A9:B21. (i.e; "Contestant #1")
Their guesses are listed in C9:C21.
The difference between the randomized number and the guess is listed in D9:D21
D9:D21 =IF(C9>$B$3,C9-$B$3,IF($B$3>C9,$B$3-C9,0))
Cells F9:F21 let you know who won and doesn't count any guesses that are less than 1 and more than 100.
F9:F21 =IF(C9<1,,IF(C9>100,,IF(D9=MIN($D$9:$D$21),A9&" Wins",)))
Unfortunately, every time I try to reference in cell C6 or F6 instead of 1 or 100 I only get the result of 0.
In F8 I have a notification that pops up if there is a tie. Still not sure if this code is the best way to do this.
F8 =IF(COUNTIF(F9:F21,"*")>1,"Tie Breaker Needed","")
Here's my question. I know how to recognize duplicates and I can highlight them if I want to. I can't seem to find a way to have a single cell tell me exactly who has won even if there is a tie.
I.e; If Contestant #7 Wins --- Cell would say "Contestant #7 Wins"
If Contestants #7 & #10 win --- Cell should say Contestant #7 & Contestant #10 Tie.
Is there a command or VBA module that could do this for me? I tried the VBA module below that I found but it only returns #NAME? No matter what I do.
Either this code works and I'm not inserting the module correctly or this module doesn't work for my situation and I need something new.
Help me Oh Great Excel Sages of the Online Realm.
Image of My Excel Worksheet
Option Explicit
Function LookupCSVResults(lookupValue As Integer, lookupRange As Range, resultsRange As Range) As String
Dim s As String 'Results placeholder
Dim sTmp As String 'Cell value placeholder
Dim r As Long 'Row
Dim c As Long 'Column
Const strDelimiter = "|||" 'Makes InStr more robust
s = strDelimiter
For r = 1 To lookupRange.Rows.Count
For c = 1 To lookupRange.Columns.Count
If lookupRange.Cells(r, c).Value = lookupValue Then
'I know it's weird to use offset but it works even if the two ranges
'are of different sizes and it's the same way that SUMIF works
sTmp = resultsRange.Offset(r - 1, c - 1).Cells(1, 1).Value
If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
s = s & sTmp & strDelimiter
End If
End If
Next
Next
'Now make it look like CSV
s = Replace(s, strDelimiter, ",")
If Left(s, 1) = "," Then s = Mid(s, 2)
If Right(s, 1) = "," Then s = Left(s, Len(s) - 1)
LookupCSVResults = s 'Return the function
End Function
How about the following UDF():
Option Explicit
Public Function ListWinners(people As Range, deltas As Range) As String
Dim wf As WorksheetFunction
Dim i As Long, delta As Long, msg As String
Dim WinningValue As Long
Set wf = Application.WorksheetFunction
ListWinners = ""
msg = " wins"
WinningValue = wf.Min(deltas)
For i = 1 To deltas.Rows.Count
If deltas(i) = WinningValue Then
If ListWinners = "" Then
ListWinners = people(i)
Else
ListWinners = ListWinners & " & " & people(i)
msg = " tie"
End If
End If
Next i
ListWinners = ListWinners & msg
End Function
In your posted example, use it like:
=ListWinners(A9:A21,C9:C21)
to display the winner list in a single cell.
EDIT#1:
User Defined Functions (UDFs) are very easy to install and use:
ALT-F11 brings up the VBE window
ALT-I
ALT-M opens a fresh module
paste the stuff in and close the VBE window
If you save the workbook, the UDF will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the UDF:
bring up the VBE window as above
clear the code out
close the VBE window
To use the UDF from Excel:
=ListWinners(A1:A100,B1:B100)
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
and for specifics on UDFs, see:
http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
Macros must be enabled for this to work!
I am working with a sheet with almost 200 named ranges (each column is a NR). I now would like to make them dynamic i.e. instead of defining them like
PersonID = =RawData!$A$2:$A$100
I want to do it this way
PersonID = OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)
But I do not want to do this manually! Is there a way to do this in a texteditor outside Excel or is there a way to do this programatically? I already have the 200 NRs done in the first way in place, but the thought of manually go through them all to change is scaring me.
You can do it in VBA. Example to create a new name:
ActiveWorkbook.Names.Add Name:="PersonID", _
RefersTo:="=OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)"
To edit an already existing name:
ActiveWorkbook.Names("PersonID").RefersTo = _
"=OFFSET(RawData!$A$2,0,1,COUNTA(RawData!$A:$A),1)"
You indicate in a comment that you would also like to iterate through all named ranges to facilitate changing their definition. To loop through all names you can do this:
Dim nm As Name
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name
Next nm
or this:
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
Debug.Print ActiveWorkbook.Names.Item(i).Name
Next i
This seems to be a pretty good tool to have in your toolbox?
Sub MakeRangesDynamic()
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
If Not (ActiveWorkbook.Names.Item(i).Name = "NameToExclude1" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude2" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude3") Then
FindTheColumn = Mid$(ActiveWorkbook.Names.Item(i).RefersTo, 11, 2)
If Mid$(FindTheColumn, 2, 1) = "$" Then
FindTheColumn = Mid$(FindTheColumn, 1, 1)
Else
FindTheColumn = Mid$(FindTheColumn, 1, 2)
End If
DynNameString = "=OFFSET(RawData!$" & FindTheColumn & "$2,0,0,COUNTA(RawData!$" & FindTheColumn & ":$" & FindTheColumn & "),1)"
Debug.Print DynNameString
'ActiveWorkbook.Names.Item(i).Name.RefersTo = DynNameString
End If
Next i
End Sub
A special thanks goes to Jean-Francois for helping me out.
Change the RawData to your sheetname and the NameToExclude to your ranges to leave untouched.
Remove the last comment for making it happen! But be sure to make a backup copy first!!!!
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub