I have a web application that generates two different Excel reports with different numbers of leaves and different number of columns, see below.
Report 1
Sheet1 has four columns headed C11, C12, C13, C14
Sheet2 has three columns headed C21, C22, C23
Report 2
Sheet1 has four columns headed C11, C12, C13, C14 (same as in Report 1)
Sheet2 has three columns headed C21, C22, C23 (same as in Report 1)
Sheet3 has three columns headed C31, C32, C33, C34, C35,....
I want to be able to remove some columns in the reports of two levels that I should enter, see below:
Level 1: Search for Sheet1 and remove the C12 and then
Search for Sheet2 and remove C22, then
Search Sheet3, and remove C32
Level 2: Search for Sheet1 and remove the C11 and C13, then
Search for Sheet2 and remove the C21 and C22, then
Search Sheet3, and remove C33, C34, C35
I want the macro first asks for the level and then searches for each Sheet and looking forward for each column and remove it as described above.
Use the following code. Run the Macro 'Choose' to select the level. This code deletes the entire column where the conditions are true
Sub Choose()
l = InputBox(Prompt:="Enter the level you want", Title:="Level Selection")
If l = 1 Then
Call Level1
ElseIf l = 2 Then
Level2
ElseIf l = "" Then
Else
MsgBox "Incorrect entry.", vbInformation, "Incorrect"
End If
End Sub
Sub Level1()
Application.ScreenUpdating = False
On Error Resume Next
Blad1.Activate
Blad1.Cells.Find(What:="C12", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad1.Columns(i).Delete
Blad2.Activate
Blad2.Cells.Find(What:="C22", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad2.Columns(i).Delete
Blad3.Activate
Blad3.Cells.Find(What:="C32", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad3.Columns(i).Delete
Blad1.Activate
Application.ScreenUpdating = True
End Sub
Sub Level2()
Application.ScreenUpdating = False
On Error Resume Next
Blad1.Activate
Blad1.Cells.Find(What:="C11", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad1.Columns(i).Delete
Blad1.Cells.Find(What:="C13", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad1.Columns(i).Delete
Blad2.Activate
Blad2.Cells.Find(What:="C21", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad2.Columns(i).Delete
Blad2.Cells.Find(What:="C22", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad2.Columns(i).Delete
Blad3.Activate
Blad3.Cells.Find(What:="C33", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad3.Columns(i).Delete
Blad3.Cells.Find(What:="C34", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad3.Columns(i).Delete
Blad3.Cells.Find(What:="C35", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
i = ActiveCell.Column
Blad3.Columns(i).Delete
Blad1.Activate
Application.ScreenUpdating = True
End Sub
Please see the file including macro
Related
In a variable selection of cells in single column, I'm needing to swap "Buy" with "Sell", and vice-versa.
I tried something like this...but when first Selection.Replace changes "Sell" to "Buy", then 2nd one just changes "Buy" back to "Sell" -
Data sample
I havent found that I can nest a Selection.Replace..would need to loop down thru each cell somehow?
....
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial
Selection.Replace What:="Bought", Replacement:="Sold", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Selection.Replace What:="Sold", Replacement:="Bought", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
To achieve what you want, you can replace three times instead of just two times.
The solution shows how to do it, while avoiding the use of Copy, Paste and Select, to make sure we don't interfere with the user selection and the clipboard.
Sub Doit()
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng As Range
Dim Lst As Variant
' Get the range in column B from row 4 and down.
Set Rng1 = Range("B4")
Set Rng2 = Rng1.End(xlDown)
Set Rng = Range(Rng1, Rng2)
' Copy the range to column C
Lst = Rng
Range("C4").Resize(UBound(Lst, 1), UBound(Lst, 2)) = Lst
' Replace Bought with Sold and Sold with Bought
Rng.Replace What:="Bought", Replacement:="#B#o#u#g#h#t", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Rng.Replace What:="Sold", Replacement:="Bought", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Rng.Replace What:="#B#o#u#g#h#t", Replacement:="Sold", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub
The solution assumes that your data does not contain the string "#B#o#u#g#h#t". You can use whatever string you want instead of "#B#o#u#g#h#t", as long as the string does not appear in your data.
As with your example, the solution does not test, if there is any valid data in Column B from row 4 and down.
So I have a code that finds three rows and insert the same rows below them, but I need to clear contents of these inserted rows, unfortunately, the selecetion applies for the first three rows and not those inserted.
Sub Add_Timber()
'
' Add_Timber Macro
'
'
Cells.Find(What:="Timber | Zakázky:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
Cells.Find(What:="Timber | JIRA ID:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
Cells.Find(What:="Timber | Hodiny:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireRow.Copy
Selection.Offset(3, 0).Insert Shift:=xlDown
End Sub
So in picture a red block is copied from the previous and I want to delete the data in the NEW INSERTED rows.
Since rows are Always conscutive and in the same ordwer, then you could make copy/insert in one shot
Sub Add_Timber()
Dim f As Range
Set f = Cells.Find(What:="Timber | Zakázky:", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)' try finding "Timber | Zakázky:"
If Not f Is Nothing Then 'if succesfull
With f.Resize(3).EntireRow ' reference found cell row along with its two consecutive ones
.Offset(3).Insert ' insert referenced rows three rows below the referenced ones
.Copy .Offset(3) ' copy referenced rows three rows below
End With
End If
End Sub
Column A to H has data with some blanks in between. I want to find "ABC" in column A and then select 2 rows above - this will be my ActiveCell.
I want to delete rows in between ActiveCell to Row2 (Active Cell is Dynamic)
Sub format()
Cells.Find(What:="abc", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:= xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
ActiveCell.Offset(-2, 0).Select
Range(Selection, ActiveCell, A2).Select
End Sub
The code will do the job for you:
Sub format()
Dim rng As Range
Set rng = Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
rng.Offset(-2, 0).Select
Range(Cells(Selection.Row, 1), Cells(2, 1)).Select
'Selection.EntireRow.Delete
End Sub
Currently I have commented out the last line which will delete the Rows you want. uncomment it, but first be sure that's what you want to delete.
For Range please try:
(ActiveCell, "A2").Select
When I perform a "Cells.Find" after selecting a column the search unexpectedly leaves the selected column.
I would expect the Find to remain in the column I selected just like when using the 'Find" function in Excel.
'Select first row of data set locations
ActiveWorkbook.Worksheets("Sheet1").Activate
Cells.EntireColumn("C").Select
Set First = Cells.Find(What:=ww_from, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Thanks in advance for your help.
Scott
Cells.Find( is looking at the whole sheet not just what is selected. If you only want to search in column C then use this in place of all you have given:
With ThisWorkbook.Worksheets("Sheet1")
Set First = .Column("C").Find(What:=ww_from, After:=.Range("C1"), LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
End With
If you do not want to change Selection, consider:
ActiveWorkbook.Worksheets("Sheet1").Activate
Dim r as Range
Set r = Columns(3).Cells
Set First = r.Find(What:=ww_from, After:=r(1), LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
I'm working with hourly weather data in Excel that has each hour of every day of the year along with the corresponding temperature value that was recorded.
Some of the values weren't recorded, and instead show up as just an "M" on the spreadsheet. For example, A32 = 28, A33 = M, A34 = 30. I want to replace that "M" with a formula to take the average of the previous and next values. I know how to do this manually, but I am having difficulty writing a Macro to find all the M's in the spreadsheet, then auto-replace it as stated above.
My main obstacle is getting excel to use the correct values when replacing the "M".
Here is my code
Sub MReplace()
'
' MReplace Macro
'
'
ActiveCell.Select
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(-8, 1).Range("A1").Select
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Replace What:="M", Replacement:="[****This is what I am having difficulty with****]", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="M", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False).Activate
End Sub
I have heard of something that you can put in to the code that can address the selected cell. I think it's cell() but I am not sure. Maybe that is a way to get it to work better?
Try this code:
Sub MReplace()
Dim ws As Worksheet
Dim cel As Range
Dim firstAddress As String
Set ws = ActiveSheet
Set cel = ws.Range("A:A").Find("M")
If Not cel Is Nothing Then
firstAddress = cel.Address
Do
cel.Value = (cel.Offset(1) + cel.Offset( -1)) / 2
Set cel = ws.Range("A:A").FindNext(cel)
hr = False
If Not cel Is Nothing Then
If cel.Address <> firstAddress Then
hr = True
End If
End If
Loop While hr
End If
End Sub
It loops through all the cells containing "M" and replaces it with the average of the one on the right and the one on the left. It will error on any that are in the first column as there is no column to the left.