I am trying to copy the format of the first row to all the rows that are filled up with data. After that, the rest of the rows (empty) are deleted.
Normally this should be done with the sheet not selected. The code below works good, except when the user has both other sheets and the xsInvestmentSummary jointly selected. In that case, when pasting, the other sheets are also modified.
I don't understand why. In this code, all refers to xsInvestmentSummary.
With xsInvestmentSummary
If .Cells(FilaTitulo + 3, 1).Value <> "" Then
Set CeldaInicio = .Cells(FilaTitulo + 2, 1)
Set CeldaFin = CeldaInicio.End(xlDown)
.Cells(FilaTitulo + 1, 1).EntireRow.Copy
.Range(CeldaInicio, CeldaFin).EntireRow.PasteSpecial Paste:=xlPasteFormats ' After this line, the other selected sheets are modified
Set CeldaInicio = .Cells(CeldaFin.Row + 1, 1)
Set CeldaFin = CeldaInicio.End(xlDown)
.Range(CeldaInicio, CeldaFin).EntireRow.Delete
End If
End With
Related
Here I go again, another simple Function that I cannot seem to find anywhere.
instead, i see other related discussions/codes but they are more complex that how i need it.
I have Three Pivot tables, they are connected via a slicer so when i select one Item, all of them will be filtered in the same parameter.
I would only want to hide the blank rows between a two Pivot table that are blank, excluding 1 rows for each to allow for viewing separation. I tried to use a Recording macro but seems like there's no way i can expect the relative Reference mode to help on this when i use xlUp and xlDown.
in the attached image is sample of what are the blank rows that will be hidden.
Thank you so much in advance!
Sub HideBlanks()
Dim nRow
' First, show all rows
Cells.EntireRow.Hidden = False
' Then go from the last row to the third one,
For nRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row To 3 Step -1
' check that several columns of that row are blank (Cells(nRow, 1) = "" And Cells(nRow, 2) = "" And Cells(nRow, 3) = "" )
' and also check that the row above is blank also (And Cells(nRow - 1, 1) )
If Cells(nRow, 1) = "" And Cells(nRow, 2) = "" And Cells(nRow, 3) = "" And Cells(nRow - 1, 1) = "" Then
' If so, hide the row
Cells(nRow, 1).EntireRow.Hidden = True
End If
Next nRow
End Sub
I have a VBA code that will compare two values in two different worksheets. When condition gets true, it supposed to select a column and insert one column to right in one workbook only (in my case, it should be in ws, not in wsProductivity).
Though I used With & End With statement, the selection and insertion were happened in both worksheets that I used for comparison.
The code is below.
'ws & wsProductivity - two sheets that are used for comparison
count = 0
For j = 0 To wsProductivity.Range("D3").Value - wsProductivity.Range("D2").Value
If ws.Cells(4, j).Value <> wsProductivity.Cells(wsProductivity.Range("D1").Value, count + wsProductivity.Range("D2").Value).Value Then
With ws
Columns(j).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'Here is the issue where insertion happened in both ws and wsProductivity sheets
End With
ws.Cells(4, j).Value = wsProductivity.Cells(wsProductivity.Range("D1").Value, count + wsProductivity.Range("D2").Value).Value
count = count + 1
Else
count = count + 1
End If
Next j
It would be very much appreciated, if someone could help on it..
I have 2 rows of numbers in a source workbook. I would like to copy the first row into another workbook, then make the row below it the sum of the source's first & second rows. My code runs but I can't seem to get excel to read the values of the second row. (aa is the source workbook's sheet)
With aa
For i = 1 To Range(Range("U2").Offset(1, 0), Range("U2").Offset(1, 0).End(xlToRight)).Cells.Count
Set NewValue = Range("U2").Offset(1, i - 1)
TargetWB.Worksheets("Sheet1").Range("D2").Offset(1, i - 1).Value = Range("D2").Offset(0, i - 1) + NewValue.Value
Next
End With
I have an excel worksheet with a lot of data that needs pruning.
Data is a organized by ID number with multiple rows attached to a given ID. For each unique ID, I need to to keep all rows with certain codes (which are found in column B). I also need to keep the rows immediately above the rows with the "keeper codes," provided such a row exists. If no such row exists, then I need to insert a blank row.*
For a given ID, if no "keeper code" is present, then all rows associated with the ID should be deleted. All rows not associated with a "keeper code" or immediately above a row with a "keeper code" should be deleted.
Probably best explained by screenshot. Data will be sorted by ID number as pictured.
*Inserting a blank row would be nice but if it makes the coding difficult then is not very necessary.
Thanks much!
Try this out,
Sub copyRows()
Dim i As Long, j As Long
Sheets.Add.Name = "newSheet"
Rows(1).Copy Sheets("newSheet").Cells(1, 1)
j = Sheets("newSheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If InStr(Cells(i, 2), "Keep") > 0 And Cells(i, 1) = Cells(i - 1, 1) Then
Rows(i - 1).Copy Sheets("newSheet").Cells(j, 1)
Rows(i).Copy Sheets("newSheet").Cells(j + 1, 1)
ElseIf InStr(Cells(i, 2), "Keep") > 0 Then
Rows(i).Copy Sheets("newSheet").Cells(j, 1)
End If
j = Sheets("newSheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
Next i
End Sub
If inserting empty rows is necessary you may have to work on that logic.
This macro creates a new sheet with the output.
I have files of data with the following format:
In column A, identifiers occur either doubly (e.g. 302_60) or singularly (e.g.310_58). Additional information is present in column B.
What I want to do is:
tag the rows that have single identifiers in column A with
TRUE/FALSE in Column C
for any TRUE tag, insert a line BELOW
copy into the inserted row the contents of the ENTIRE tagged row (here just columns A,B)
I solved #1 using =COUNTIF(A:A, A1)=1
I then wrote a VBA script to solve #2
Sub ins_below_and_copy()
Dim c As Range
For Each c In Range("C1:C100")
If InStr(1, c, "TRUE", vbTextCompare) > 0 Then
Rows(c.Offset(1, 0).Row & ":" & c.Offset(1, 0).Row).Insert Shift:=xlDown
End If
Next c
End Sub
Achieving the desired end result (#3)
seems simple enough, right? I have been trying .Copy and .Paste commands, but keep getting type-mismatch errors, an error that does not make sense to me (since I am not a competent VBA coder). Any ideas?
You have down all the hard work, filling in the gaps is easy. Select the two columns, HOME > Editing - Find & Select, Go To Special..., Blanks, OK, =, UP and Ctrl+Enter.
You can run this after you have your empty rows created.
Dim sheet As String
Dim lastRow As Long
sheet = "SheetName"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow 'Assuming you have a Header Row
If Sheets(sheet).Cells(r, 1) = "" Then
Sheets(sheet).Cells(r - 1, 3) = "FALSE"
Sheets(sheet).Cells(r, 1) = Sheets(sheet).Cells(r - 1, 1)
Sheets(sheet).Cells(r, 2) = Sheets(sheet).Cells(r - 1, 2)
Sheets(sheet).Cells(r, 3) = Sheets(sheet).Cells(r - 1, 3)
End If
Next r