Referring to a different cell and extracting Substrings in VBA - vba

I have 2 sheets, "Report" and "Data". In the "Data" sheet are values in column A as follows T-Shirt.Adidas.25.110 I need to take the raw data and input them into the "Report" Sheet as separate entities.
ex. Cell A1 will read "T-Shirt" Cell B1 will read "Adidas"
Here is what I have so far. Its a with statement but that will only work for one line. Im not sure how to loop it.
Dim Cell As Object
Dim Data As Range
Dim Report As Range
Set Report = Worksheets("Report").Range("A2", Range("A2").End(xlDown))
Set Data = Worksheets("Data").Range("A2", Range("A2").End(xlDown))
With Report
.Resize(1, 4) = Split(Worksheets("Data").Range("A2"), ".")
End With
The macro needs to work for any number of objects in the data sheet.
Thanks in advance!

Here is one way to loop:
Sub test()
Dim Cell As Object
Dim Data As Range
Dim Report As Range
Dim i As Long, TempArray As Variant
Set Data = Worksheets("Data").Range("A2", Worksheets("Data").Range("A2").End(xlDown))
Set Report = Worksheets("Report").Range("A2")
For i = 1 To Data.Count
TempArray = Split(Data.Range("A" & i), ".")
Report.Offset(i - 1).Resize(1, UBound(TempArray) + 1) = TempArray
Next i
Set TempArray = Nothing
End Sub
This way you use the Data as the source and count of iterations, and you can generalize the columns based on the number of periods in a given piece of data.

Related

Excel VBA - Grouping list of strings in one cell

I don't know how to best describe this but it's better that I explain my problem in pictures.
I have 2 worksheets:
In worksheet Array, there are certain periods with their corresponding 'Array' associated with them.
In Sheet1, there is a list of strings in the format: dd/mm/yyyy hh:mm:ss AM/PM - # ordered by ascending order of number, then by date and finally by time.
The code I have, generates those values in Sheet1 by extracting the data in Array and listing them out in one cell. The code I've used is.
Sub Filter()
Const Array_FirstRow As Integer = 2 'Indicates the first row (row 2) in Array sheet
Dim Array_RowIndex As Integer 'variable to loop through array values of col A
Dim Summary_PeriodMoment1 As String 'in worksheet Sheet 1
Array_RowIndex = Array_FirstRow
Array_LastRow = Array_RowIndex - 1
Summary_PeriodMoment1 = ""
For Array_RowIndex = Array_FirstRow To Array_LastRow
If Summary_PeriodMoment1 <> " " Then
Summary_PeriodMoment1 = Summary_PeriodMoment1 & ", " & Worksheets("Array").Cells(Array_RowIndex, Array_DateTime_Column).Value
End If
Next
Sheet1.Cells(1, 1).Value = Summary_PeriodMoment1
End Sub
This is slightly confusing and overly complicated to read. Is there any way to add code to :
Sort/group the values by # and consolidate by date (to make it less confusing)? Like so?
Have a separate cell for each value, again categorized by # (I would like to plot these values on a pivot graph later on using other code, so would like it to be in a friendly format
Essentially I would like to do some data reformatting/transposing with a VBA script. Any idea what functions I should use? thanks!
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Update: I have what I need for transposing a string of values in one cell. I wonder if this can be done for multiple cells. I tried using this code:
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim Arr1 As Variant
Dim Arr2 As Variant
Dim InputRng As Range, InputRng2 As Range, InputRng3 As Range, OutputRng As Range, OutputRng1 As Range, OutputRng2 As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set InputRng1 = Range("B2")
Set InputRng2 = Range("B3")
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Set OutputRng1 = Range("G1")
Set OutputRng2 = Range("J1")
Arr = Split(InputRng.Value, ",")
Arr1 = Split(InputRng.Value, ",")
Arr2 = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
Set OutputRng1 = OutputRng1.Resize(UBound(Arr1) - LBound(Arr1) + 1)
OutputRng.Value = Application.Transpose(Arr1)
Set OutputRng2 = OutputRng2.Resize(UBound(Arr2) - LBound(Arr2) + 1)
OutputRng.Value = Application.Transpose(Arr2)
End Sub
Seems it only works for InputRng and not InputRng1 or InputRng2
1.
How to split comma-delimited data in one cell? (Look below)
1.1. If you don't have any other data, and number of records are not more than number of possible columns in excel then transposing within the worksheet is an option (Instead of using the code below).
1.2. (If you have more data than limit of excel columns): Otherwise, you need to use arrays. The code below answers first part of your question. It will split the cell for "," as delimiter.
2.
Then you can use Text to Columns in Data tab and delimiter ":" to get the numbers in one column and dates in another one.
3.
Use How To Transpose Cells In One Column Based On Unique Values In Another Column? to group them based on the numbers.
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim InputRng As Range, OutputRng As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Arr = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
End Sub

Loop through data validation list, copy and paste (variable number of cells) into another sheet, below each other

Hoping someone's able to kindly help me out with this!
I'm essentially trying to create a macro, which will loop through a list("A3") in one sheet("Dashboard"), and then copy the results (B3:B7) and paste into a second sheet ("PrintSheet", Column "A"), with all the results being pasted under each other.
So far, I've managed to come up with the following code, but for some reason, it only seems to copy and paste one row of results (B3, not B4,5,6 or 7).
Any help would be truly appreciated!
Sub SpitValues()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long
'Cell that contains data validation list
Set dvCell = Worksheets("Dashboard").Range("A3")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
i = 1
'Begin loop
Application.ScreenUpdating = False
For Each c In inputRange
dvCell = c.Value
Worksheets("PrintSheet").Cells(i, "A").Value = Worksheets("Dashboard").Range("B3:B7").Value
i = i + 1
Next c
Application.ScreenUpdating = True
End Sub
You can't directly assign the values from a multi-cell range to a single cell: both the source and destination must be the same size:
Worksheets("PrintSheet").Cells(i, "A").Resize(5, 1).Value = _
Worksheets("Dashboard").Range("B3:B7").Value

VBA: Filter table data based on drop down selection

I would like to filter a table Column C, based on a drop down list selection.
I have more lines, where I can select Country code form the drop down list.
I would like to filter my table based on the country code selection.
For example:
First line: "54" country code selected
Second line "24" country code selected
And so on....
The table on the other tab will be filtered by the selected country code "54","24".
Can you please help me how can I manage it?
Thank you :)
Sub FilterRangeCriteria()
Dim vCrit As Variant
Dim wsFiltered As Worksheet
Dim wsSelection As Worksheet
Dim rngCrit As Range
Dim rngOrders As Range
Dim Lastrow As Integer
'you need more variables to save the range in an array
Dim valArr As Variant
Dim cl As Range
Dim i As Integer
Set wsFiltered = Worksheets("S") ' I want to filter this tab with "Centre Information" selection
Set wsSelection = Worksheets("Centre Information")
Set rngOrders = wsFiltered.Range("b:b") 'I want to filter this column
Lastrow = Worksheets("Centre Information").Cells(Rows.Count, 2).End(xlUp).Row
myrange = ("b3:b" & Lastrow) ' the value from B3 until last row: this will be the filter data
Set rngCrit = wsSelection.Range(myrange)
vCrit = rngCrit.Value
'I get error here: Autofilter method of range class failed
'Correction: Fill array
ReDim valArr(Lastrow - 3) 'define array size (first two rows are empty + considering the first array position starts with 0)
i = 0
For Each cl In rngCrit 'loop through range
valArr(i) = "=" & cl 'filter for each value + operator
i = i + 1
Next cl
'Correction: use array als range of numbers which shall be matched
rngOrders.AutoFilter _
Field:=1, _
Criteria1:=valArr, _
Operator:=xlFilterValues
End Sub
Comment: If you want to filter for a range, using autofilter you have provide an array which contains all values in string format. Filtering numbers requires an operator: e.g. "=", "<=", etc. Best regards.

Quicker way to filter out data based on a particular value

I am working with a workbook that currently has 3 sheets. The first sheet is an overview where the filtered data will appear. Cell D11 has the color that I am looking for. Upon entering the color cells F3:I27 Populate with information like color, shape, number and animal.
C2C-Tracker2
I would use a Pivot Table for this, however, I have another set of data in K3:M27. This data is pulled from another sheet within the workbook with a similar function.
The formula that I am using is:
=IFERROR(INDEX(cases!A:A,SMALL(IF(EXACT($D$3,cases!$C:$C),ROW(cases!$C:$C)-ROW($F$1)+1),ROW(1:1))),"")
Of course it is entered using CTRL + SHIFT + ENTER for it to work properly.
I tried using a VBA Macro that I pulled from the video below:
Excel VBA Loop to Find Records Matching Search Criteria
So many array formulas can really make your workbook very slow.
Here is a code to populate Dataset1 using arrays. It runs in less than a second.
Hope this gets you started. I have commented the code but if you still have a problem understanding, just post back :)
Sub Sample()
Dim DSOne() As String
Dim tmpAr As Variant
Dim wsCas As Worksheet: Set wsCas = ThisWorkbook.Sheets("Cases")
Dim wsMain As Worksheet: Set wsMain = ThisWorkbook.Sheets("Sheet1")
Dim lRow As Long, i As Long, j As Long
'~~> Check if user entered a color
If wsMain.Range("D3").Value = "" Then
MsgBox "Please enter a color first", vbCritical, "Missing Color"
Exit Sub
End If
'~~> Clear data for input in main sheet
wsMain.Range("F3:F" & wsMain.Rows.Count).ClearContents
'~~> Get last row of Sheet Cases
lRow = wsCas.Range("A" & wsCas.Rows.Count).End(xlUp).Row
With wsCas
'~~> Get count of cells which have that color
i = Application.WorksheetFunction.CountIf(.Columns(3), wsMain.Range("D3").Value)
'~~> Check if there is any color
If i > 0 Then
'~~> Define your array to hold those values
ReDim DSOne(1 To i, 1 To 4)
'~~> Store the Sheet Cases data in the array
tmpAr = .Range("A1:D" & lRow).Value
j = 1
'~~> Loop through the array to find the matches
For i = LBound(tmpAr) To UBound(tmpAr)
If tmpAr(i, 3) = wsMain.Range("D3").Value Then
DSOne(j, 1) = tmpAr(i, 1)
DSOne(j, 2) = tmpAr(i, 2)
DSOne(j, 3) = tmpAr(i, 3)
DSOne(j, 4) = tmpAr(i, 4)
j = j + 1
End If
Next i
'~~> write to the main sheet in 1 Go!
wsMain.Range("F3").Resize(UBound(DSOne), 4).Value = DSOne
End If
End With
End Sub
Screenshot:
Using the above approach now populate Dataset2 :)

Writing a Macro to Use the Transpose Function Repeatedly

I am trying move rows of values into a column in Excel. The transpose function works well, but will only move one row at a time. I would like to get a macro that will convert 173 rows of data across three columns into one column. Please see example below.
Thanks in advance for any help.
Rows:
98,058 98,058 98,314
82,362 82,684 83,326
93,410 93,479 93,761
Columns:
98,058
98,058
98,314
82,362
82,684
83,326
93410
93479
93761
The following will load the data from the CurrentRegion of A1 into an array and paste into one column, beginning in A5.
I'm assuming the data is numerical, contiguous and that this is a one-off, rather than an exercise that might have to be repeated on data sets of differing sizes. If your data is not contiguous, or not bound by empty cells, then you can hard code the range instead.
Private Sub transposeRows()
Dim inputRange As Variant
Dim myArray() As Long
Dim x As Long
Dim testCell As Range
'Get the range of data to copy'
Set inputRange = Range("A1").CurrentRegion
'Resize array to fit'
ReDim myArray(inputRange.Count - 1)
'Fill up array with data'
For Each testCell In inputRange
myArray(x) = testCell
x = x + 1
Next testCell
'Fill destination range'
Range("A5:A" & UBound(myArray) + 5) = WorksheetFunction.Transpose(myArray)
End Sub