I got 3000 rows of data in Excel.
Each row contains the same type of information but not in the right order.
What i need to do is to gather the same type of information under the same column.I would like to create a macro that is going to:
Search a row for a partial string (some values have similar strings but fall under different categories)
If the string is part of a cell copy the entire cell in a
new location
Repeat for the next row
Thanks in advance
Sub MoveColumns()
Dim LastRow As Long
Dim rFind As Range
Dim r As String
Dim m As Integer
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
MsgBox (LastRow)
For n = 1 To LastRow
r = n & ":" & n
Range(r).Select
With Range(r)
Set rFind = .Find(What:="Spain*", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
If rFind.Column < 6 Then
m = 6 - rFind.Column
Range(Cells(n, 1), Cells(n, m)).Insert Shift:=xlToRight
ElseIf rFind.Column > 6 Then
m = rFind.Column - 6
Range(Cells(n, 1), Cells(n, m)).Delete Shift:=xlToLeft
End If
End If
End With
Next
End Sub
UPDATED
If row doesn't contain any value starts with "Spain", this row is simply ignored and skipped.
I hope you can modify and customize the way suitable for your data.
Related
I have a chart where I need to remove certain keywords from column C- Range C3:C5000(some cells are blank). The words that needs to be removed are placed in column A- Range A3:A100(some cells are blank). Both ranges gets changed for different files. I have written a code but its not working for dynamic range. Also I want to sort column c according to no. of characters in cell in Ascending order. please help
Sub Replace_Char()
Dim i As Integer
Dim Mpp As String
For i = 3 To 50
Mpp = Cells(i, 1).Value
If Cells(i, 1).Value <> 0 Then
Worksheets("Sheet1").Columns("C").Replace _
What:=Mpp, Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
End If
Next i
End Sub
For dynamic ranges, you can try using the .UsedRange property.
As for sorting by number of characters, create a column that has the formula like "=LEN(D1)" and then sort the sheet on that column.
Sub Replace_Char()
Dim i As Integer
Dim Mpp As String
'For i = 3 To 50
Dim Thing As Range
For Each Thing In ActiveSheet.UsedRange.Columns(1).Cells
Mpp = Cells(i, 1).Value
If Cells(i, 1).Value <> 0 Then
Worksheets("Sheet1").Columns("C").Replace _
What:=Mpp, Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
End If
'Next i
Next
End Sub
I am attempting to compare two columns in two separate sheets, each column contains data that is a string. My issue is that there is data in one column that is identical to the other in separate rows; therefore I have to check the entire column for the data before moving to the next. I am very inexperienced with VBA and am trying to make one portion of my job easier rather than comparing the columns by hand. I have piece wised the following code from research and trial and error. I am able to get the entire Column searched in my first Sheet, but only one value is being highlighted on the second sheet and then it is returning a value of "True" in the first column. I am unsure where I have gone wrong, any help is greatly appreciated!
Sub Better_Work_This_Time()
Dim FindString As String
Dim Rng As Range
ActiveCell = Sheets("Last Week").Range("A2").Activate
FindString = ActiveCell
Dim County As Integer
Count = Cells.CurrentRegion.rows.Count
For i = 2 To County
If Trim(FindString) <> "" Then
With Sheets("Current Week").Range("A:A")
Set Rng = .Find(What:=FindString, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
If Not Rng Is Nothing Then
ActiveCell.Font.Color = vbBlue
End If
End With
End If
If IsEmpty(FindString) Then
FindString = False
End If
ActiveCell.Offset(1, 0).Select
i = i + 1
Next
End Sub
Without using ActiveCell and using Match instead of Find.
Option Explicit
Sub Does_Work_This_Time()
Dim wb As Workbook, wsLast As Worksheet, wsCurrent As Worksheet
Dim FindString As String, ar, v
Dim LastRow As Long, i As Long, n As Long
Set wb = ThisWorkbook
' put current week values into array
Set wsCurrent = wb.Sheets("Current Week")
With wsCurrent
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
ar = .Range("A2:A" & LastRow).Value2
End With
' scan last week matching current week
Set wsLast = wb.Sheets("Last Week")
With wsLast
.Columns(1).Interior.Color = xlNone
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
FindString = Trim(.Cells(i, "A"))
If Len(FindString) > 0 Then
v = Application.Match(FindString, ar, 0)
If IsError(v) Then
'no match
ElseIf ar(v, 1) = FindString Then ' case match
.Cells(i, "A").Interior.Color = RGB(128, 255, 128) ' light green
n = n + 1
End If
End If
Next
End With
MsgBox n & " rows matched"
End Sub
I have one table and one file. I can find the text which is in specific place in file inside the table.
However, the texts are not unique all the time, so I decided to combine 2 cells in file and try to find in table. unless, I cannot find a way to combine 2 columns in table to match it with combined 2 cells in file.
Below you may see example table.
my aim is adding date in cell next cell of Units. So I try to find A1234 instead of 1234 due to 1234 not unique.
FindString = wb.Sheets("1").Range("E4").Value & wb.Sheets("1").Range("E5").Value
If Trim(FindString) <> "" Then
With Wb2.Sheets("Sheet1").Range("A:A") 'this section need to be amended and need combine column A&B
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Rng.Offset(0, 1).Value = wb.Sheets("1").Range("I4") ' if column A&B combining completed then next cell probably will not work
Else
MsgBox "Nothing found in the list"
End If
This is similar to the variant strategy mentioned in the comments-- Try looping through your data with a For loop and an If Statement looking for both values to match. Here's an example code that shows the concept
Sub test()
Dim s As Worksheet, findstring1 As String, findstring2 As String
Dim firstrow As Integer, lastrow As Integer, i As Integer
Set s = Sheets("test")
findstring1 = "A "'replace this with the Customer reference (what to search for)
findstring2 = "1234" 'replace this with the unit reference
firstrow = 2 ' row number for first cell with data
lastcell = s.Cells(2, 1).End(xlDown).Row 'find last cell row number (end of data)
For i = firstrow To lastcell
If s.Cells(i, 1) = findstring1 And s.Cells(i, 2) = findstring2 Then
'do something with found values
End If
Next i
End Sub
I have a large excel file with consistent columns but they're not placed too accurately;
The example in the photo is illustrative to my problem; I'm only interested in the information after the "country" column.
Therefore, within each row, I would like to
1. check each row to find a specific string of characters - in this case "Spain".
2. move the row so that the cells with the strings found are all on the same column.
In the example below, all the rows should be moved so that "Spain" is under column F - arranging the rest of the info with it.
If word Spain isn't changed, use this VBA code:
Sub MoveCoun()
Dim LastRow As Long
Dim rFind As Range
Dim r As String
Dim m As Integer
LastRow = 1000
For n = 1 To LastRow
r = n & ":" & n
Range(r).Select
With Range(r)
Set rFind = .Find(What:="Spain", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
If rFind.Column < 6 Then
m = 6 - rFind.Column
Range(Cells(n, 1), Cells(n, m)).Insert Shift:=xlToRight
ElseIf rFind.Column > 6 Then
m = rFind.Column - 6
Range(Cells(n, 1), Cells(n, m)).Delete Shift:=xlToLeft
End If
End If
End With
Next
End Sub
Is there a way to find the average for a block of data in the same column?
This is the code I was using before which wasn't working the way i had hoped for data with fewer numbers:
Sub Macro1()
'Macro1
Do Until ActiveCell.Value = ""
'Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=AVERAGE(R[-13]C:R[-1]C)"
Selection.End(xlDown).Select
Loop
End Sub
Example: the image is the file I'm working on. I've got thousands of rows of this data and it's all separated by three blank rows. Is there a way to find the averages of each block of data and display it in the first blank row directly underneath the data?
Try this: (for columnA considering 3 gaps after each block including last block)
Sub DoAvginColumn()
Dim i as long, q as long, avgBlock
Dim lastrow as Range, firstrow as Range, rngcolA as Range, rngBlock as Range
Set lastrow = Range("A:A").Find(What:="*", After:=[A1], SearchDirection:=xlPrevious)
Set firstrow = Range("A:A").Find(What:="*", After:=[A1], SearchDirection:=xlNext)
Set rngcolA = Range("A" & firstrow.Row & ":" & "A" & lastrow.Row)
q = 1
For i = 1 To rngcolA.Rows.Count + 1
If rngcolA(i).Value = "" And rngcolA(i + 1).Value = "" And rngcolA(i + 2).Value = "" Then
Set rngBlock = Range(rngcolA(q), rngcolA(i - 1))
avgBlock = WorksheetFunction.Average(rngBlock)
rngcolA(i).Value = avgBlock
rngcolA(i).Font.Bold = True
q = i + 3
End If
Next
End Sub
APPENDED: Steps I followed: From top to bottom of respective range:
search for 3 consecutive blank.
If found, then define an appropriate range for each block starting with 1st cell of that block and ending with last cell of that block.
Then applied avg function on that block and put result below the block.