Sheet contains commission data for employees.
Data is dumped out of Accounting system each week.
Need to move a cell value "Totals" down 1 row to align with the relevant data.
Have tried to search for the string "Totals" then cut and paste 1 row lower.
The string is in col-A. The dataset size and content rows is variable each week but the target string is always in col-A and needs to drop down 1 row, probably with an offset (1, 0) style of command?
Dim m As Integer
m = 2
Do Until m = 300 'this is set to cover the expected occurrences
On Error Resume Next
Range(A1, A300).Cells("m", 0).Find(What:="Totals").Offset(1, 0) = "TOTALS"
m = m + 1
On Error GoTo 0
Loop
Getting no error messages but no results either!
Forget the 'Cut & Paste'. Simply insert a new row at the 'Totals' row.
dim m as variant
m = application.match("totals", range("A:A"), 0)
if not iserror(m) then
rows(m).insert
end if
(and YES you should qualify your parent worksheets!)
So this is what I think you are after. Define the range where the "Totals" lie - assuming they are in a Row? See below code.
Sub LoopTotals()
Dim cell As Range
Dim myRange As Range
'set the range
Set myRange = Sheet1.Range("A1:AA1")
'loop through range
For Each cell In myRange
'check if text is "Totals"
If Trim(cell.Text) = "Totals" Then
'set the new "Totals" 1 row lower
cell.Offset(1, 0).Value = "Totals"
'delete the old string value
cell.ClearContents
End If
Next
End Sub
Additionally, if the "Totals" are pulled in differently each time from the accounting software then you can run a search to find the "Totals" and then you can reference that row number for you range.
Related
My Excel looks like this
Project
Type
Business Intelligence
1001
Apples
1002
Oranges
1003
Oranges
1004
Bananas
1005
Apples
1006
Apples
So when I filter column "B" to have only Apples I want to be able to paste the "1001, 1005" in the Column C (Business Intelligence Column) of the 6th Row (inline with project 1006) to indicate that we have done Apples twice before. The comma between the values is not important, even a space will do
After reading multiple posts, I came across the closest possible solutions for me.
Option Explicit
Sub CopyToY()
Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific
' First Cell of the Data Range (in the row below headers)
Dim fCell As Range: Set fCell = ws.Range("A2")
' Last Cell of the Filtered Range
Dim lCell As Range: Set lCell = ws.Range("A" & ws.Rows.Count).End(xlUp)
' If no filtered data, the last cell will be the header cell, which
' is above the first cell. Check this with:
If lCell.Row < fCell.Row Then Exit Sub ' no filtered data
' Range from First Cell to Last Cell
Dim rg As Range: Set rg = ws.Range(fCell, lCell)
' Filtered Data Range
Dim frg As Range: Set frg = rg.SpecialCells(xlCellTypeVisible)
' Area Range
Dim arg As Range
For Each arg In frg.Areas
arg.EntireRow.Columns("Y").Value = arg.Value ' **this is where it all goes wrong for me - I don't want to paste in column Y but in C6 as "1001, 1005"**
Next arg
MsgBox "Filtered data copied to column ""Y"".", vbInformation
End Sub
Now working towards pasting as value in C6, instead of column Y I found this code.
Sub JoinCells()
Set xJoinRange = Application.InputBox(prompt:="Highlight source cells to merge", Type:=8)
xSource = 0
xSource = xJoinRange.Rows.Count
xType = "rows"
If xSource = 1 Then
xSource = xJoinRange.Columns.Count
xType = "columns"
End If
Set xDestination = Application.InputBox(prompt:="Highlight destination cell", Type:=8)
If xType = "rows" Then
temp = xJoinRange.Rows(1).Value
For i = 2 To xSource
temp = temp & " " & xJoinRange.Rows(i).Value
Next i
Else
temp = xJoinRange.Columns(1).Value
For i = 2 To xSource
temp = temp & " " & xJoinRange.Columns(i).Value
Next i
End If
xDestination.Value = temp
End Sub
But unfortunately this code is taking the invisible filtered rows too. Which means my C6 value is showing as 1001 1002 1003 1004 1005 1006
What I want to do is take the first part of the first code and automatically take the contents of the filtered column A (Project) and then use the second part of the second code to be able to paste the answer "1001, 1005" in C6 (Business Intelligence Column, in line with Project 1006) - This can be done either by highlighting the destination cell OR even better automatically choosing the last visible cell in Column C
I am not a programmer have never learnt coding, I just run my own business - tried my best to get this done but unfortunately am unable to be able to successfully merge these two codes.
Any help would be appreciated.
Maybe you want to try something like this ?
Sub test()
Dim rg As Range
Dim i As Integer
Dim cell As Range
Dim x As String
If ActiveSheet.FilterMode Then
Set rg = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Application.CountA(rg) < 2 Then Exit Sub
i = 0
For Each cell In rg
i = i + 1
If cell.Address = Range("B" & Rows.Count).End(xlUp).Address Then
cell.Offset(0, 1).Value = x
Else
If i = 1 Then x = cell.Offset(0, -1) Else x = x & ", " & cell.Offset(0, -1)
End If
Next
End If
End Sub
The sub above will not automatically run each time you filter the data, as it need to be run manually after you filter the data. The code also doesn't do error checking (for example if you filter the data with a criteria which doesn't exist in the data).
First the code check if the active sheet is filtered, if yes then it
sets the range of the filtered data which visible (the rg variable). If the count of that range is bigger than 1, then the process :
loop to each cell of that range
if it's the first time loop, then it get the value of column A, the looped cell.offset(0,-1) as x variable
if it's not the first time loop, then it will add the value of x with ", " and the value of column A, the looped cell.offset(0,-1).
once the looped cell address is the same with the last row of the visible data of rg, it write the x value to column C in the same row of the last row of the visible data.
Still not sure though if that's what you want. And I wonder if the data will grow or just static. If it will grow, (from your apple example) will there two rows in column C where the last second row contains 1001 and 1005 (the result of the macro before) and the last row contains 1001, 1005 and 1006 ?
I have an Excel table that is 6 columns wide (A-F) by 13,000 rows when it opens. I want to write a macro that will begin with cell B1 and check to see if it contains a specified letter (which I will put in another, unused cell). If it does, I want to delete the entire row and move the other rows up. Then the macro should begin again with the B1 and repeat the process. If B1 does not contain the specified letter, I want to successively check C1-F1. If any of them contain the specified letter, I want to delete that row, move the other rows up, and begin again with B1.
If none of the cells B1-F1 contain the specified letter, then I want to leave the row in the table. Then I want to begin testing the next row with B2 (or Bn) I want to continue this process until I have checked Fn in the last row with data, and have either kept or deleted that row.
What I want to be left with is a table containing all the rows from the original set where the specified letter appears in any of the cells in columns 2-6 of the row.
I have been away from Excel macros for twenty years, and so really need some pointers as to how to implement the row deletion, moving up the rows, and hard parts like that.
The fastest way to do this is build up a multiple-area range (that is a read-only operation that won't modify the worksheet) and then delete it in a single operation.
This VBA routine should do it:
Public Sub DeleteRowsHavingCriterion()
Dim J As Integer
Dim nrows As Integer
Dim ws As Worksheet
Dim UsedRange As Range
Dim toDeleteRange As Range
Dim ThisRow As Range
Dim DeleteThisRow As Boolean
Set ws = Application.ActiveWorkbook.Worksheets("WorksheetToProcess")
Set UsedRange = ws.UsedRange
Let nrows = UsedRange.Rows.Count
For J = nrows To 1 Step -1
Set ThisRow = UsedRange.Rows(J).EntireRow
DeleteThisRow = ( _
(ThisRow.Cells(1, 2).Value = "LetterForColumnB") Or _
(ThisRow.Cells(1, 3).Value = "LetterForColumnC") Or _
(ThisRow.Cells(1, 4).Value = "LetterForColumnD") Or _
(ThisRow.Cells(1, 5).Value = "LetterForColumnE") Or _
(ThisRow.Cells(1, 6).Value = "LetterForColumnF") _
)
If (DeleteThisRow) Then
If (toDeleteRange Is Nothing) Then
Set toDeleteRange = ThisRow
Else
Set toDeleteRange = Union(toDeleteRange, ThisRow)
End If
End If
Next J
If (Not (toDeleteRange Is Nothing)) Then
toDeleteRange.Delete (XlDeleteShiftDirection.xlShiftUp)
End If
End Sub
I hope I can make this make sense.
I am trying to find "Text1" in column A and if found, find the date above "Text1", offest up 6 rows and copy "Text2" there and paste it into another worksheet. Then I need it to do it all again from the next instance of "Text1". "Text1" not always the same distance from the date, "Text2" is always 6 rows above the date and is City, State Zopcode. I really only need the zipcode.
The text is from a daily file so the date changes daily :). I usually find pieces of code and am able to tweak them to work for me, but everything I've tried so far hasn't worked. This worked earlier today, but doesn't now and doesn't loop through (all loops that I've tried have ended with infinite loops)
Sub GetZip()
Worksheets("Data_Test").Activate
Range("A1").Activate
' FInd first instance of Text1
Cells.Find(What:="Text1", After:=ActiveCell).Activate
' Find the date
Cells.Find(What:="12-Feb-14", After:=ActiveCell, SearchDirection:=xlPrevious).Select
' copy and paste Text2
ActiveCell.Offset(-6, 0).Copy
Worksheets("Data2").Select
Range("A65000").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial (xlPasteAll)
Worksheets("Data_Test").Activate
'go back to Text1 that was found before
Cells.Find(What:="Housing Counseling Agencies", After:=ActiveCell).Activate
'find the next instance of Text1
Cells.Find(What:="Housing Counseling Agencies", After:=ActiveCell).Activate
End Sub
I get Run-time error 91 on:
Cells.Find(What:="12-Feb-14", After:=ActiveCell, SearchDirection:=xlPrevious).Activate
I see that you are still over-using "Activate" and "Select". These are common mistakes when you are just starting out. As I mentioned in my answer to another StackOverflow question, you should try to avoid doing that. I went ahead and created a macro that I think will do what you've asked, and I included comments which should explain each line of code. This way, you can also see how the code works in case you want to recreate or modify it. Let me know if it gives you any trouble...
Sub GetZip()
Dim Report As Worksheet, bReport As Workbook, Report2 As Worksheet 'Create your worksheet and workbook variables.
Dim i As Integer, k As Integer, j As Integer, m As Integer 'Create some variables for counting.
Dim iCount As Integer, c As Integer 'This variable will hold the index of the array of "Text1" instances.
Dim myDate As String, Text2 As String, Text1 As String, Data_Test As String, Data2 As String 'Create some string variables to hold your data.
Dim rText1() As Integer 'Create an array to store the row numbers we'll reference later.
Dim r As Range 'Create a range variable to hold the range we need.
'==============================================================================================================================
' Below are three variables: Text1, Data_Test, and Data2.
' These represent variables in your specific scenario that I did not know what to put. Change them accordingly.
'==============================================================================================================================
'Enter your "Text1" value below (e.g., "Housing Counseling Agencies")
Text1 = "Text1" 'Assign the text we want to search for to our Text1 variable.
'Enter the names of your two worksheets below
Data_Test = "Data_Test" 'Assign the name of our "Data_Test" worksheet.
Data2 = "Data2" 'Assign the name of our "Data2" worksheet.
'==============================================================================================================================
' This assigns our worksheet and workbook variables.
'==============================================================================================================================
On Error GoTo wksheetError 'Set an error-catcher in case the worksheets aren't found.
Set bReport = Excel.ActiveWorkbook 'Set your current workbook to our workbook variable.
Set Report = bReport.Worksheets(Data_Test) 'Set the Data_Test worksheet to our first worksheet variable.
Set Report2 = bReport.Worksheets(Data2) 'Set the Data2 worksheet to our second worksheet variable.
On Error GoTo 0 'Reset the error-catcher to default.
'==============================================================================================================================
' This gets an array of row numbers for our text.
'==============================================================================================================================
iCount = Application.WorksheetFunction.CountIf(Report.Columns("A"), Text1) 'Get the total number of instances of our text.
If iCount = 0 Then GoTo noText1 'If no instances were found.
ReDim rText1(1 To iCount) 'Redefine the boundaries of the array.
i = 1 'Assign a temp variable for this next snippet.
For c = 1 To iCount 'Loop through the items in the array.
Set r = Report.Range("A" & i & ":A" & Report.UsedRange.Rows.Count + 1) 'Get the range starting with the row after the last instance of Text1.
rText1(c) = r.Find(Text1).Row 'Find the specified text you want to search for and store its row number in our array.
i = rText1(c) + 1 'Re-assign the temp variable to equal the row after the last instance of Text1.
Next c 'Go to the next array item.
'==============================================================================================================================
' This loops through the array and finds the date and Text2 values, then places them in your new sheet.
'==============================================================================================================================
For c = 1 To iCount 'Loop through the array.
k = rText1(c) 'Assign the current array-item's row to k.
For i = k To 1 Step -1 'Loop upward through each row, checking if the value is a date.
If IsDate(Report.Cells(i, 1).Value) Then 'If the value is a date, then...
myDate = Report.Cells(i, 1).Value 'Assign the value to our myDate variable.
j = i 'Set the j variable equal to the current row (we want to use it later).
Exit For 'Leave the loop since we've found our date value. **Note: jumps to the line after "Next i".
End If
Next i 'Go to the next row value.
Text2 = Report.Cells(j - 6, 1).Value 'Subtract the date row by six, and store the "Text2"/[city, state, zip] value in our Text2 variable.
m = Report2.Cells(Report2.UsedRange.Rows.Count + 1, 1).End(xlUp).Row + 1 'Get the row after the last cell in column "A" that contains a value.
Report2.Cells(m, 1).Value = Text2 'Paste the value of the city,state,zip into the first available cell in column "A"
Next c 'Go to the next array-item.
Exit Sub
wksheetError:
MsgBox ("The worksheet was not found.")
Exit Sub
noText1:
MsgBox ("""" & Text1 & """ was not found in the worksheet.") 'Display an error message. **NOTE: Double-quotations acts as a single quotation in strings.
Exit Sub
End Sub
I have a row of data that changes once a month but it only changes roughly 30 cells out of 90 and every month they are different so I am trying to make a Macro to automate it.
The Macro looks at Cells A2 - B98 and searches for information that matches the Values of H2-I98 and if the values in A match H then it copies what the value is in I and replaces it in B but it doest stop at the end of the row i.e. at row 98 it loops infinatly. So I was hoping someone could find my error so that it wont loop for ever. Thanks
Sub Update_Holiday()
Dim Search As String
Dim Replacement As String
Dim rngTmp As Range
Dim rngSearch As Range
LastInputRow = Range("A65536").End(xlUp).Row
Set rngSearch = Worksheets("Holiday").Range(Cells(2, 1), Cells(98, 2))
For k = 2 to 98
Search = Worksheets("Holiday").Cells(k, 8)
Replacement = Worksheets("Holiday").Cells(k, 9)
With rngSearch
Set rngTmp = .Find(Search, LookIn:=xlValues)
If rngTmp Is Nothing Then
GoTo Go_to_next_input_row:
Else
Worksheets("Holiday").Cells(rngTmp.Row, rngTmp.Column + 1).Value = Replacement
End If
End With
Go_to_next_input_row:
Next K
End Sub
If I understand your question correctly: for each Cell in H2:H98, you're looking for a match in A2:A98. It won't necessarily be on the same row. If you find a match in Column A, you want to take the value from Column B and put it in Column I on the same row as the search value we just looked for. In this case, this code will work:
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim srcRng As Range '' Source range
Dim schRng As Range '' Search range
Dim c As Range
Dim search As Range
Set ws = ThisWorkbook.Sheets(1)
Set srcRng = ws.Range("H2:H98")
Set schRng = ws.Range("A2:A98")
For Each c In srcRng '' Iterate through your source range
Set search = schRng.Find(c.Value, LookIn:=xlValues, SearchDirection:=xlNext) '' Find the value from column H in column A
If Not search Is Nothing Then
c.Offset(, 1).Copy search.Offset(, 1) '' Get the value from column B, from the same row as the value it found in column A
'' Then paste that value in column I, on the same row as the value we searched for from column H
End If
Next c
GoTo statements are generally (generally, not always) very, very bad practice. Especially in this kind of situation. You don't need them, it just makes your code convoluted.
Date | data | data | data
12/29| G | F | G
12/30| G | |
I have a spreadsheet like above. I want to find the row that is the current date, then reference the row that is the current date in a Range type. Then cycle through the data in that row.
I can find the current date, and get the address of the cell that is the current date:
dateRange = "A1:" & regionSheet.Range("A1").End(xlDown).Address
For Each cell In regionSheet.Range(dateRange)
If cell.Value = Date Then
row = cell.Address
End If
Next cell
That returns $A$2. I need to somehow turn this into a Range type. I tried using the cell.Address like below:
row = cell.Address & ":" & regionSheet.Range(row).End(xlRight).Address
but that errors out.
Maybe I'm going about this the wrong way? Any ideas?
range(cell, cell.End(xlToRight)).Address
OR
range(cell.Address, range(cell.Address).End(xlToRight)).Address
EDIT: If you want it to have it in Range type, you could use
range(cell, cell.End(xlToRight))
Be warned that the End() function can return incorrect results if there are gaps in the data. For example, if you had data in the second and fourth columns, End will not give you the result you want.
You could try something like this (assumes your data starts in row 1 and column 1):
Sub RowOfCurrentDate()
Dim lngCurrDateRow As Long
Dim lngNumCols As Long
Dim rngDates As Range
Dim rngToday As Range
Dim c As Range
'Get current region and count the number of columns
Set rngDates = Range("A1").CurrentRegion
lngNumCols = rngDates.Columns.Count
'Resize the range down to one column
Set rngDates = rngDates.Resize(rngDates.Rows.Count, 1)
'Find today's date in the range
lngCurrDateRow = Application.WorksheetFunction.Match(CLng(Date), rngDates, 0)
'Set the range to search through for today
Set rngToday = Range(Cells(lngCurrDateRow, 1), Cells(lngCurrDateRow, lngNumCols))
'then loop through all cells in that range
For Each c In rngToday
'if cell is not empty
If Len(c) > 0 Then
'do something
End If
Next c
End Sub