I am trying to copy some 8-digit numbers to use in a SQL search.
The SQL query gave me errors and after some debugging I found that the string doesn't contain all the data. It seems that after 25 or so numbers my for loop stops entering data as if the string is full.
Thanks for the help...
Lots = ""
For iRow = 2 To 500
If IsEmpty(Sheets("Filtered Data").Cells(iRow, 2)) Then Exit For
Lots = Lots & ",'" & Sheets("Filtered Data").Cells(iRow, 2).value & "'"
Next iRow
Lots = "(" & Mid(Lots, 2, Len(Lots) - 1) & ")"
you should post your data raising the errors
as for while you can consider the following code to build-up the string exploiting Join() function
Dim Lots As String
With Worksheets("Filtered Data") '<--| change "Filtered Data" with your actual worksheet name
With .Range("B2", .Cells(.Rows.Count, 2).End(xlUp)) '<-- consider its column "B" cells from row 2 down to last non empty one
Lots = "('" & Join(Application.Transpose(.Value), "','") & "')" '<-- build up the string
End With
End With
this assumes that all non empty cells in column "B" are contiguous (i.e. non blank cells in between non blank ones), but it can be easily modified should this not be the case
Your code works fine. Presumably you have an empty cell in the column which is making it exit the loop....
Related
My situation is as follows. I have a list of around 2k student accounts and sort the information to a specific format that i can format to our new CRM. The way the data is presented initially makes that problematic.
As you can see on the first screenshot, every student's university choice is presented in a separate row. So if a student has chosen more than one university, data about it is stored in 2-6 rows (each student can select 1 to 6 universities) repeating his personalID, name, forename and DoB every line.
What I need to achieve is to remove repeating information and store all data about each student in one row per student(example on screenshot 2).
I have no idea how to achieve this using VBA. I was trying with IFs, loops and arrays but without any progress. I need help on how to accomplish that using VBA.
Please let me know if you need more information. I will try to explain it in more details if required.
Screenshot 1
Screenshot 2
EDIT: This is the part of the report. I am working on a macro that will format it to our needs and will give us more info about the student's accounts. That is why I am asking for help in VBA.
No need to use VBA for this. Power Query will help you better. Have a look here: https://excelgorilla.com/power-bi/power-query/aggregate-text-values-using-group-by/
This seems to work. I'm new to VBA and programming in general so it's possibly not the most efficient solution and can definitely be improved.
Instead of working with a blank sheet, it transforms the current data to the format you wanted. You can add field headings where you want.
Edit: It assumes that each Student has 5 universities in the list. The code can be adjusted to account for any number by just adjusting the target range dynamically.
Edit 2: I added the change to account for students who've entered any number of universities between 1 to 5. Let me know if this gets it done!
Sub ReArrange_Data()
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim First As Integer
Dim Last As Integer
Dim test As Integer
Dim test1 As Integer
Dim student_range As Range
Dim student_rows As Integer
Dim target_range As Range
First = 2
For i = 2 To lrow
Last = First
If Cells(First, "D").Value = "" Then GoTo Break 'reached end of data
While Cells(Last, "D").Value = Cells(Last + 1, "D").Value
Last = Last + 1
Wend
If Last <> First Then 'check if mulitiple uni and build range
Set student_range = Range("E" & First & ":" & "E" & Last)
student_rows = student_range.Rows.Count
If student_rows = 5 Then
Set target_range = Range("E" & First & ":" & "I" & First)
ElseIf student_rows = 4 Then
Set target_range = Range("E" & First & ":" & "H" & First)
ElseIf student_rows = 3 Then
Set target_range = Range("E" & First & ":" & "G" & First)
ElseIf student_rows = 2 Then
Set target_range = Range("E" & First & ":" & "F" & First)
End If
Else
GoTo Skip 'student entered one uni, go to next loop
End If
target_range = Application.WorksheetFunction.Transpose(student_range.Value) 'row to column
Rows(First + 1 & ":" & Last).EntireRow.Delete
Skip: 'delete repeated entries
First = First + 1
Next i
Break:
End Sub
I was trying to copy from column D to column E first two words of each row but still can not find where the error is....
Range("E1:E" & lLastRow).Formula = "=LEFT(D1,FIND("" "",D1,FIND("" "",D1)+1)-1)"
Another option, instead of using a Formula, you can use the Split function.
Code
Dim i As Long, LastRow As Long
Dim WordsArr As Variant
' loop through rows
For i = 1 To LastRow
WordsArr = Split(Range("D" & i).Value, " ") ' use Split and space to read cell words to array
If UBound(WordsArr) >= 1 Then ' make sure the cell contents is at least 2 words
Range("E" & i).Value = WordsArr(0) & " " & WordsArr(1) ' insert only the first 2 words
Else ' in case there are less than 2 words
' do someting....
End If
Next i
End Sub
Try this instead ...
Range("E1:E" & lLastRow).FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1],FIND("" "",RC[-1])+1)-1)"
I find using R1C1 better for those sort of operations, especially given you want your references to be dynamic, not absolute.
Alternatively, add the formula you had normally and simply fill down.
I am trying to create a Module that will format an excel spreadsheet for my team at work. There is one column that will contain the word "CPT" and various CPT codes with descriptions.
I need to delete all text (CPT description) after the 5 digit CPT code but alsp keep the word CPT in other cells.
For example: Column S, Row 6 contains only the word "CPT" (not in quotations)
Then Column S, Row 7 contains the text "99217 Observation Care Discharge"
This setup repeats several times throughout Column S.
I would like for Row 6 to stay the same as it is ("CPT") but in Row 7 i only want to keep "99217"
Unfortunately, this is not possible to do by hand as there are several people who will need this macro and our spreadsheets can have this wording repeated hundreds of times in this column with different CPT codes and descriptions.
I have tried various If/Then statements, If/Then/Else
Sub CPTcolumn()
Dim celltxt As String
celltxt = ActiveSheet.Range("S6" & Rows.Count).End(xlUp).Text
Dim LR As Long, i As Long
LR = Range("S6" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If InStr(1, celltxt, "CPT") Then
Next i
Else
With Range("S6" & i)
.Value = Left(.Value, InStr(.Value, " "))
End With
Next i
End If
End Sub
When i try to run it I get Various "Compile Errors"
I would do this differently.
Given:
The cell to be modified will be the cell under a cell that contains CPT
in the algorithm below, we look for CPT all caps and only that contents. Easily modified if that is not the case.
Since you write " a five digit code", we need only extract the first five characters.
IF you might have some cells that contain CPT where the cell underneath does not contain a CPT code, then we'd also have to check the contents of the cell beneath to see if it looked like a CPT code.
So we just use the Range.Find method:
Sub CPT()
Dim WS As Worksheet, R As Range, C As Range
Dim sfirstAddress As String
Set WS = Worksheets("sheet4")
With WS.Cells
Set R = .Find(what:="CPT", LookIn:=xlValues, lookat:=xlWhole, _
MatchCase:=True)
If Not R Is Nothing Then
sfirstAddress = R.Address
Set C = R.Offset(1, 0)
C.Value = Left(C.Value, 5)
Do
Set R = .FindNext(R)
If Not R.Address = sfirstAddress Then
Set C = R.Offset(1, 0)
C.Value = Left(C.Value, 5)
End If
Loop Until R.Address = sfirstAddress
End If
End With
End Sub
If this sequence is guaranteed to only be in Column S, we can change
With WS.Cells
to With WS.Columns(19).Cells
and that might speed things up a bit.
You may also speed things up by adding turning off ScreenUpdating and Calculation while this runs.
Your first error will occur here:
ActiveSheet.Range("S6" & Rows.Count).End(xlUp).Text
Because you're trying to retrieve text from the last used range starting .End(xlUp) at Range("S61048576"), which is roughly 58 times the row limit in Excel. You might change Range("S6" & Rows.Count) to Range("S" & Rows.Count)
Your second error will occur here:
LR = Range("S6" & Rows.Count).End(xlUp).Row
Which will be the same error.
The third error will occur here:
For i = 1 To LR
If InStr(1, celltxt, "CPT") Then
Next i
You cannot nest half of an If-End If block in a For-Next loop, or vice-versa and you've done both. If you want to iterate and perform an If-End If each iteration, you need to contain the If-End If within the For-Next like
For i = 1 To LR
If InStr(1, celltxt, "CPT") Then
'Is the purpose here to do nothing???
Else
With Range("S" & i)
.Value = Left(.Value, InStr(.Value, " "))
End With
End If
Next i
EDIT:
For technical accuracy, your first error would actually be your broken up For-Next and If-End If, as you wouldn't even be able to compile to execute the code to run into the other two errors.
You can simply use the Mid function in the worksheet.
As I understood from your question that you need to separate numbers and put them in other cells, is this true?
To do this, you can write this function in cell R6 like this
=Mid(S6,1,5)
Then press enter and drag the function down and you will find that all the cells containing numbers and texts have been retained numbers in them
I've just created a brand new macro. Took function down below from internet (all credits goes to trumpexcel.com), code down below
Function CONCATENATEMULTIPLE(Ref As Range, Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In Ref
Result = Result & Cell.Value & Separator
Next Cell
CONCATENATEMULTIPLE = Left(Result, Len(Result) - 1)
End Function
Then I proceed to extract data from various columns and into the one (my table is 20 rows x 10 columns)
Sub conact_data()
Dim i As Integer
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "M").Value = Cells(i, "A").Value & " " & _
Cells(i, "B").Value & " / " & Cells(i, "D").Value & "; "
Next i
End Sub
Thanks to that I've got combined data from column A, B and D, so its 20 rows. All I want to do now is to concatenate data from M2:M21 using CONCATENATEMULTIPLE function therefore I try various approach (I want this huge line in P2 cell) like :
Cells(2, 16).Value = CONCATENATEMULTIPLE (M2:M21, " ")
or
Range("P2") = "CONCATENATEMULTIPLE (M2:M21, " ")"
I don't really know how to apply that
Secondly, I'd like withdraw the Cells(i, "B").Value as percentage. Can I do that in one line like Cells(i, "B").NumberFormat="0.00%".Value (which is not working for me obviously) else I need to copy column B into another column with number format and then combine the new column, properly formatted instead of column B?
Thanks in advance
Percent format: Range("B" & i).NumberFormat = "0.00%"
CONCATENATEMULTIPLE
In VBA, CHR(32) = " "
In Excel, CHAR(32) = " "
With that being said...
'Value
Range("P2").Value = CONCATENATEMULTIPLE(Range("M2:M21"), CHR(32))
'Formula
Range("P2").Formula = "=CONCATENATEMULTIPLE(M2:M21, CHAR(32))"
You should really qualify all of your ranges with a worksheet
Say your workbook has 10 sheets. When you say Range("P2"), how do we (VBE) know what sheet you mean? Objects need to be properly qualified. Sometimes this is not a huge issue, but when you are working across multiple sheets, not qualifying ranges can lead to some unexpected results.
You can qualify with a worksheet a few ways.
Directly: ThisWorkbook.Sheets("Sheet1").Range("P2").Copy
Or use a variable like so
Dim ws as Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("P2").Copy
Now there is no room for ambiguity (potential errors) as to the exact location of Range("P2")
First of all, remove your ConcatenateMultiple() code, and instead use Excel worksheet function CONCAT(), which takes a range and a delimiter as parameters.
Here is how you can handle the percentage issue and supply a default for non-numeric items. I've also cleaned up the way you reference your data range.
Sub concat_data()
Dim rngRow As Range, vResult As Variant
Const DEFAULT = 0 'Can also be set to a text value, eg. "Missing"
For Each rngRow In [A2].CurrentRegion.Rows
If IsNumeric(rngRow.Cells(, 4)) Then vResult = rngRow.Cells(, 4) * 100 & "%" Else vResult = DEFAULT
Range("M" & rngRow.Row) = rngRow.Cells(, 1) & rngRow.Cells(, 2) & "/" & vResult & ";"
Next
[M2].End(xlDown).Offset(1).Formula = "=CONCAT(M2:M" & [M2].End(xlDown).Row & ",TRUE,"" "")"
End Sub
I'm not a fan of hard-coding range references, like the [A2] or Range("M"), but will leave that for another time.
I have an Excel project which has a few thousand rows containing strings which need sorting out.
Typically one cell in each row should have a six digit number 123456 but many are 123456/123456/234567 etc. which need to have the / deleted and then be separated onto individual rows. There is other information in the surrounding columns which needs to stay with these six digit numbers.
I decided to approach this by firstly making copies of the rows the appropriate number of times and then deleting the surplus information
This code below deals with the copying part and it works.. but it's really slow. Is there a quicker way to achieve what I'm trying to do?
Thanks for any help.
Chris
Sub Copy_extra_rows()
Application.ScreenUpdating = False
s = 2
Do Until s = Range("N20000").End(xlUp).Row
'checks for / in Mod list
If InStr(1, Range("N" & s), "/") Then
'determines number of /
x = Len(Range("N" & s)) - Len(Replace(Range("N" & s), "/", ""))
'loops x times and copies new row
For a = 1 To x
Range("J" & s & ":O" & s).Select
Selection.Copy
Range("J" & s + 1).Select
Selection.Insert Shift:=xlDown
s = s + 1
Next a
Else
End If
s = s + 1
Loop
End Sub
I would have approached this differently to optimize the process and improve the overall efficiency of code.
Firstly, I would load the entire column into an array. This way it's always faster to access the elements of that array rather then referring Cells() multiple times in loops. Working with objects in memory is much faster because your client doesn't need to for example update the UI. Generally, arrays big O is O(1) which means you instantly can access an object/data stored at a specific index.
Let's consider an SSCCE.
Then the code (*Note: I have added comments in the code in the right places, hopefully that helps you understand what is going on)
Sub Main()
Dim columnArray As Variant
' create an array from Range starting at L2 to the last row filled with data
columnArray = Range("N2:N" & Range("N" & Rows.Count).End(xlUp).Row)
Dim c As New Collection
' add separate 6 digit numbers to the collection as separate items
' iterate the columnArray array and split the contents
Dim element As Variant
For Each element In columnArray
If NeedSplitting(element) Then
Dim splittedElements As Variant
splittedElements = Split(element, "/")
Dim splittedElement As Variant
For Each splittedElement In splittedElements
c.Add splittedElement
Next
Else
c.Add element
End If
Next
' print the collection to column Q
PrintToColumn c, "Q"
End Sub
Private Sub PrintToColumn(c As Collection, ByVal toColumn As String)
Application.ScreenUpdating = False
' clear the column before printing
Columns(toColumn).ClearContents
' iterate collection and print each item on a new row in the specified column
Dim element As Variant
For Each element In c
Range(toColumn & Range(toColumn & Rows.Count).End(xlUp).Row + 1) = element
Next
Application.ScreenUpdating = True
End Sub
Private Function NeedSplitting(cell As Variant) As Boolean
' returns true if the cell needs splitting
If UBound(Split(cell, "/")) > 0 Then
NeedSplitting = True
End If
End Function
After running the code all your numbers should appear as separate elements in column Q
NOTE: Why use a Collection?
Collections in VBA are dynamic. It means you don't have to know the size of a collection in order to use it - unlike arrays. You can re-dim your array multiple times to increase its size but that's rather considered a bad practice. You can add nearly as many items to a Collection as you want with a simple Collection.Add method and you don't have to worry about increasing the size manually - it's all done for you automatically. In this scenario the processing happens in memory so it should be much quicker then replacing cells contents inside a loop.
Try this:
Dim s As Integer
Dim splitted_array() As String
s = 2 'Assuming data starts at row 2
Do Until Range("N" & s).Value = vbNullString Or s >= Rows.Count
'Split the array
splitted_array = Split(Range("N" & s).Value, "/")
If UBound(splitted_array) > 0 Then
'Set the first value on the first row
Range("N" & s).Value = splitted_array(0)
For i = 1 To UBound(splitted_array)
'Add subsequent rows
Rows(s + i).Insert xlDown
Range("J" & s + i & ":O" & s + i).Value = Range("J" & s & ":O" & s).Value
Range("N" & s + i).Value = splitted_array(i)
Next
End If
s = s + 1 + UBound(splitted_array)
Loop
This code turns this:
into this: