Replace Cell with Header Cell - vba

I'm trying to figure out how to either substitute or replace a cell's data with existing data from a header cell.
In the most succinct way to describe it:
If cell = 'unchecked', then replace with the cell's header cell.
There are numerous columns so I can't specifically say replace with a specific cell for all. It would vary depending on the cell.
As in: (not code but won't let me save request without indentation.)
C3=unchecked, then pull C1.
H18=unchecked, then pull H1.
P4=unchecked, then pull P1.

Just cycle through the columns, replacing the term "unchecked" with the value found in the first row of that column.
dim c as long, rplc as string
rplc = "unchecked"
with activesheet
with .cells(1, 1).currentregion
for c = 1 to .columns.count
with .columns(c)
.replace what:=rplc, replacement:=.cells(1, 1).value2, _
lookat:=xlwhole, matchcase:=false
end with
next c
end with
end with
This is a generic framework and is intended to give you something to get started with. Transcribe it for your own purposes and use debug (e.g. F8) to walk through the code to make sure it is doing what you want. If you run into trouble, come back and explain what you do not understand, what errors are occurring and what you have discovered through debug.
You will want to change the ActiveSheet property reference to an actual worksheet name.

Related

Copying columns including blanks without skipping rows..leave "blanks" blank VBA

Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7

Finding function next value in a specific column

I am trying to make a macro button that will automatically select column H and then search and select one by one in an array(one every time I click the macro) every cell in that specific column, that contains the € symbol. I can do that exactly as I want manually using the native excel search function but it is time consuming. Yet I don't know how to do that in VBA. Note that the cells in column H are currency formatted..The code that almost works for me so far is this:
Search = InStr(ActiveCell.NumberFormat, Chr(128))
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
BUT the above code doesn't automatically select column H for search. I have to do that manually. When i insert in the above code Columns("H").Select (in order to make the code select the column H automatically) the macro selects the first cell that contains the € symbol in the column H (which is what i want) BUT when clicking again it does not go to the NEXT cell that contains the € symbol in that column. It sticks on the first finding. Could you please help me?
You should always avoid using Selection. or .Select.
Instead of Selection.Find specify the correct range:
Worksheets("MySheetName").Columns("H").Find
Also have a look at the Range.FindNext Method (Excel). With find you will always find the first occurrence only. For further searches you will need to use FindNext.
I am not sure what do you want to achieve, but if you need to find cells formatted as Currency, I would rather use this code:
Sub findCur()
Dim rngCol As Range
Set rngCol = Range("H:H")
With Application.FindFormat
.Clear
.NumberFormat = "$#,##0.00"
End With
rngCol.Find(What:="*", After:=ActiveCell, SearchFormat:=True).Select
End Sub
Add a condition to the selection, something like:
If Selection.Column<>7 then Columns("H").select
This way if you are already in column H, it won't reselect it, but if you are not there, it will go there.

How to delete rows that had formulas before value paste?

I got an spread sheet that include formulas and I wrote a vb code to value paste.
Depending on the input file number of rows that filled is varied and I need to delete the rows those had formulas and now empty. (This is using as connector and otherwise it some how pick these extra rows which is unnecessary)
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Above code not doing anything...
If the blanks are results of a formula like:
=""
Entered into a cell and then copied and paste as values, those are not really blank cells.
Instead, those are cells that looks blank but contains zero length strings.
SpecialCells(xlCellTypeBlanks) and even Excel formula ISBLANK won't work on it.
One way is to loop through the range and check all that contains "" and delete it.
Dim c As Range, rngtodelete As Range
For Each c In Sheet2.Range("G2:G298")
If Len(c.Value) = 0 Then
If rngtodelete Is Nothing Then Set rngtodelete = c _
Else Set rngtodelete = Union(rngtodelete, c)
End If
Next
If Not rngtodelete Is Nothing Then rngtodelete.EntireRow.Delete xlUp
Another way is using AutoFilter like this:
Sheet2.Range("G2:G298").AutoFilter 1, "="
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
I'm assuming that G2 does not contain your header but the start of your data.
If it happens to be your header, you'll need to use offset when deleting.
Sheet2.Range("G2:G298").Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
Sheet2.AutoFilterMode = False
I'm not completely sure what you mean by "This is using as connector", but I believe it has to do with an export/import process to another application.
As mentioned, a zero length string is not the same as a truly blank cell. However, you can rid your worksheet of them easily. The fastest method I am aware of is a quick cyclic run through all of the columns, applying Text-to-Columns ► Fixed width ► Finish to each.
When that is done, the zero length strings will be reverted to truly blank cells but the worksheet's used range will still overlap those empty cells found at the bottom of the dataset. This means that any export to an external program will try to export those cells. Just run .UsedRange to get Excel to reevaluate the actual used range.
First, tap Ctrl+End to see what Excel thinks is the last used cell on the worksheet. Next, run the following macro.
Sub prep_for_export()
Dim c As Long
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
With Sheets("Sheet1")
For c = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
.Columns(c).TextToColumns Destination:=.Cells(1, c), _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
Next c
End With
Sheets("Sheet1").UsedRange
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
End Sub
Edit Sheet1 in all four places if you have to before running it.
That is a little homogeneous but I think it should work for your purposes. After running the macro, tap Ctrl+End back at your worksheet again to see what Excel thinks is the last used cell on your worksheet. The before and after range addresses were recorded to the VBE's Immediate window as well.

Excel VBA; Referencing Variable Ranges

I'm trying to automate a process that takes a monthly report and generates an exception report based on the data. Since the volume of the data in the report varies from month to month, i need to account for that. What methodology is best for referencing a variable range?
For example, instead of referencing the range A1:F7087, i want to reference the entire range that includes any data. For as simple as this appears to be, I haven't been able to find any guidance on it. Appreciate any input. Thanks
Dim rng As Range
Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
This will set rng to contain all cells up to last filled, it will also contain all empty rows and columns.
You should also read this, important part from this article about xlLastCell:
Depending on what you are trying to accomplish, this cell may not be the cell that you are actually looking for. This is because, for example, if you type a value into cells A1,A2, and B1, Excel considers the last cell to be B2, which could have a value or not...
There are pros and cons with just about any method you choose to reference the dynamic block of data you wish to include with your report.
The caveat that comes with .SpecialCells(xlLastCell) is that it may encompass a cell that was previously used but is no longer within the scope of the data. This could occur if your data shrinks from one month to the next although recent service packs and updates provided for Excel 2010/2013 will shrink the rogue last cell through saving the workbook. I'm sure many of us have at one time or another mistyped a value into AZ1048576 and had to jump through hoops getting Excel to internally resize the extents of the actual data. As mentioned, with later versions of Excel, this problem is all but a footnote in history.
One last thing to note is that cells formatted as anything but plain-Jane General will halt the shrink so if last month's report had a formatted Subtotal line 50 rows below where it is this month, the .SpecialCells(xlLastCell) will be referencing an area 50 rows too long.
If you have a contiguous block of data with some blank cells possible but no fully blank rows or columns that segregate your data into islands then I prefer the following approach.
With sheets("Sheet1")
Set rng = .Cells(1, 1).CurrentRegion
End With
The area referenced by the above code can be demonstrated by selecting A1 and tapping Ctrl+A once (twice is A1:XFD1048576). The cells selected will be a rectangle encompassing the last column with data and the last row with data as the extents. Previously used cells and cells that have retained formatting from previous reports have no effect; only cell values and formulas. However, it must be emphasized that the island of data stops at the first fully blank row or column.
The last method I will mention is to position in (aka .Select or otherwise start at) A1 and use .Find with a wildcard searching backwards so that it ends up starting at XFD1048576 and searching toward A1 for the first value or formula it can find first by row then repeated by column.
Dim lr As Long, lc As Long, rng As Range
With Sheets("Sheet3")
lr = .Cells.Find(What:=Chr(42), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lc = .Cells.Find(What:=Chr(42), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set rng = .Cells(1, 1).Resize(lr, lc)
End With
This is really the only true method of getting an accurate representation of your data block but its thoroughness is not usually necessary.
Sub highlight()
Dim obj As Range
For Each obj In Sheet1.UsedRange
If obj.Value = Range("A1").Value Then
obj.Interior.Color = vbYellow
Else
obj.Interior.Color = vbWhite
End If
Next obj
End Sub

Creating a dynamic loop for cells.find function

Creating a macro that will take the cell.value (string) in worksheet A then go to Worksheet B, using the cells.find method locate the cell which match the string.
Example
SheetA.activecell.value = "Harry Potter"
set myvar = SheetA.activecell.value
sheetB.select
Cells.Find(What:=myvar, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Select
Assuming the above syntax is correct, the cell in worksheet A which contains the string "Harry Potter" will be selected automatically.
This is where my problems come in. I want to do a loop through an entire column, executing the Cells.Find function for each cell in the column.
For example, SheetA.cells(3 ,1) contains "Harry Potter". Using the offset function on every completion of the loop, the cell containing the value to be found will be offset by 1 row.
So, in the next iteration of the loop, Cells(4, 1) in SheetA will contain the value to be used in the cells.find function.
Say, that value is the string "Iphone Charger". Then, cells.find(what:=myvar (Basically myvar = "Iphone Charger") would be executed in worksheet B.
And so on down the column in worksheet A.
Secondly, I want to copy certain values in worksheets A.
Scenario:
If "Harry Potter" is found in sheetA then
Do an `activecell.offset` function to copy some values in the same row as the cell in sheet A and
Copy those values to worksheet B using Copy destination
Else if "Harry Potter" can be found then
Jump to the next cell value.
End if
Keep looping until worksheet B hits an empty cell, that is cells(X , 1).value = ""
Then the whole macro ends
Have been killing my brain cells to resolve this issue and would appreciate if any of you guys in this forum can help me.
I'd recommend using the For Each construct for your main loop on the cells with values to find in worksheet A. In pseudocode:
For each cell in column A of sheet A
With the sheet B range to look in
If cell value is ""
Exit the sub
Else
result = .find the cell value
If the find is successful ("Not result is nothing")
Copy sheetA.cells(cell.row, <column of interest>) to sheet B
Copy ... (cell.row,<another column of interest>) ...
End the If
End the if
End the with
Next cell
Note that this looks for only one instance of each value in column A of sheet A.
As Jaycal noted, you would need to use FindNext to find additional instances after the first one.
The basic idea is to find the first instance and save its address, then use a do loop with FindNext to look for more instances. The do loop keeps executing until FindNext finds a cell with the same address as the address you saved for the first instance that was found.
For a code example of this, see this explananation or this one, among many others that can be found on the web.