format rows of the same type (in while loop?) 3

[fuzzhead1506]

Hi,

I am new to vba and in an excel spreadsheet I'd like to search my sheet for all rows of the same type and format them in a way that would allow the sheet to be read a little easier.

I think a while loop is the best way to do this is a while loop, but if someone has a better idea by all means, let me know.

I was thinking that the code would look like this:
(note each row that I wish to format falls 30 rows after the last)

Sub RowLoop ()

Range("A31").Select
' This loop runs as long as there is a row of this type
Do While IsEmpty(ActiveCell) = False
ActiveCell.Offset(0,1).Delete Shift:=xlToRight
ActiveCell.Offset(0,2).Delete Shift:=xlToLeft
ActiveCell.Offset(0,15).Delete Shift:=xlToLeft
ActiveCell.Offset(0,17).Delete Shift:=xlToLeft
ActiveCell.Offset(0,8). “change contents to Status”

^^^ I have no clue of how to code this part ^^^

ActiveCell.Offset(30, 0).Select
Loop
End Sub

Sending the ActiveCell to A61, then A91

I haven’t gotten the code to work and I was hoping that this forum would help me do so! (Receiving mainly a global error.)


So ultimately, a row that looks like this:

|SSN| | | |Employee|Type| |Inst| |Date|Ticker|Source| |Action| |Shares| |Amount|

Will look like this:

| |SSN| |Employee| |Type| |Inst|Status|Date|Ticker|Source| |Action|Shares| |Amount| |


Any help would be greatly appreciated!

Thanks,

Matt

 

[yooneek]

Welcome to the forum and VBA. I'm sure you'll fall in love with makeing little things like this to optimize your life.. I know I have

On to the coding:

If you know that what and where you are trying to do things then this is fairly easy to do.

(Note: the deleting/shifting cells around takes up more processing than you really need to do)

Assuming that you always have the same information occuring at 30 row intervals and you know which cell you want to say what then I'd suggest this:


Public Sub ReFormat()
With ActiveSheet
For r = 1 To .Range("A1").End(xlDown).Row Step 30
.Cells(r, 2).Value = .Cells(r, 1).Value
.Cells(r, 4).Value = .Cells(r, 5).Value
.Cells(r, 9).Value = "Status"
.Cells(r, 15).Value = .Cells(r, 16).Value
.Cells(r, 17).Value = .Cells(r, 18).Value

.Cells(r, 1).Value = ""
.Cells(r, 5).Value = ""
.Cells(r, 16).Value = ""
.Cells(r, 18).Value = ""
Next r
End With
End Sub

The End(xlDown) finds the last cell with data starting from cell A1.

The Step function tells it how much to increase the r variable amount by, if step is not there then the increment will be 1. (You can also do negative stepping, handy if you have variable data and want to delete from bottom up)

Also, becuase this is not Selecting the cell you save on screen updating and calculation functions that Excel would run every time there was a cell change.

Obviously I don't have your dataset to play with. So please test and see if it works for you.

 

[Gavona]

You don't actually need to loop at all. I would adapt Yooneek's suggestion:
Use autofilter to display only the cells to be changed.
Then:

set r = Range("A1").End(xlDown).xlSpecialCells(xlCellTypeVisible)
  r.offset(0,2).value = r.offset(0,1).value
  etc.

I am sure this will be quicker than looping.

Gavin

 

[fuzzhead1506]

First and foremost thank you for your help.

Secondly, I think I have decided to go with the second set of code as I also have an oddball row at the very end and very beginning of my spreadsheet.

Unfortunately, when I run the macro, I get an error that doesn't that says that the object won't allow the property or method. So,

I am at a spot where I can get it to autofilter, but I would also like it to un-autofilter. Is there something for this?


Another thing, and maybe I should create a new thread for this, but the reason that my last row is oddball is that I have an extra column being created in my .csv only toward the very end. I was hoping to delete this set of cells too. The thing is that the size of the range that I would like to delete is variable. I know that I would like to use something like this:

Range(Cells.Find(What:="transaction", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(-1,0).End(xlUp)).Delete Shift:=xlToLeft


The transaction cell falls directly underneath the column that my employees are listed under and I don't wanna delete any of them above it (or the transaction cell either). Often times the range of cells that I delte is between 5 and 25. So it is very likely that I have misunderstood the xlup function.

I tried using what I thought was gonna work and received a object required message.

Unfortunately, I cannot send you an example of the spreadsheet as it contains some sensitive information.


Again, any help would be greatly appreciated.

Thank you,
Matt

 

[SkipVought]

application.displayalerts = false
Activesheet.showdata
application.displayalerts = true

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Gavona]

Whilst you can't show us the (sensitive) data you could post the code.
And you could tell us which line results in the error.
Skip's solution clears the filter settings (if you spot and correct his mistype)

    ActiveSheet.Show[red]All[/red]Data

Gavin

 

[SkipVought]

[red]SORRY![/red]

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[fuzzhead1506]

Sub Align_EE_Column_D()
'
' Align_EE_Column_D Macro
' Format tab when "Employee" header appears in column "D"
'
' Keyboard Shortcut: Ctrl+Shift+D

Range("F3:F28").Select
Selection.Delete Shift:=xlToLeft
Range("G3:G28").Select
Selection.Delete Shift:=xlToLeft
Range("H3:H28").Select
Selection.Delete Shift:=xlToLeft

Range("I5:I28").Select
Selection.Delete Shift:=xlToLeft

Range("K4:K28").Select
Selection.Delete Shift:=xlToLeft


With ActiveSheet
ActiveSheet.Range("$A$1:$A$2094").AutoFilter Field:=1, Criteria1:="SSN"

****************

--> Set r = Range("A1").End(xlDown).xlSpecialCells(xlCellTypeVisible)

****************
Errror: Object doesn't support this property or method.
****************

r.Offset(0, 1).Value = "SSN"
r.Offset(0, 2).Value = ""
r.Offset(0, 3).Value = "Employee"
r.Offset(0, 4).Value = ""
r.Offset(0, 5).Value = "Type"
r.Offset(0, 6).Value = ""
r.Offset(0, 7).Value = "Instr"
r.Offset(0, 8).Value = "Status"
r.Offset(0, 9).Value = ""
r.Offset(0, 10).Value = "Date"
r.Offset(0, 11).Value = "Ticker"
r.Offset(0, 12).Value = "Source"
r.Offset(0, 13).Value = ""
r.Offset(0, 14).Value = "Action"
r.Offset(0, 15).Value = ""
r.Offset(0, 16).Value = "Shares"
r.Offset(0, 17).Value = ""
r.Offset(0, 18).Value = "Amount"
r.Offset(0, 19).Value = ""


Application.DisplayAlerts = False
ActiveSheet.ShowAllData
Application.DisplayAlerts = True
End With



Range("S1").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
Range("S1").Select
Selection.NumberFormat = "$#,##0.00"
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D4").Select

*****Notice I have only used the macro recorder to find and activate the cell I wanna get to so I can do some deleting. (at the end of the document) *****

Cells.Find(What:="transaction", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

End Sub

 

[SkipVought]

-->  Set r = Range("A1").End(xlDown).xlSpecialCells(xlCellTypeVisible)

What do you expect this to do?

Range("A1").End(xlDown) references ONE CELL AND ONLY ONE CELL.

Did you want a range of cells in column A?

  Set r = Range(Range("A1"), Range("A1").End(xlDown)).xlSpecialCells(xlCellTypeVisible)

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Gavona]

You could also shorten the first few lines of code to:

Range("F3:I28").Delete Shift:=xlToLeft
Range("K4:K28").Delete Shift:=xlToLeft

Gavin

 

[fuzzhead1506]

I would like that line to reference the first cell in the row as there is now a filter that shows the rows only with the SSN header in the first cells for the entire column - so you were right. However, the macro runs and gets the same error for this line of code too...

 

[Gavona]

At the point where you get the error is the workbook filtered?


Gavin

 

[Gavona]

I have re-presented your code but not tested it. If you have any blank cells in column A then Range("A1").End(xlDown) will not work as you expect. If the macro fails then:
i) examine the workbook to make sure that filters are operating as you would expect.
ii) Use the watch window to view r.address
iii) Try manually performing the next step (in excel 2003: Select the range then Edit, Goto, Special, Visiblecells

Dim r as range
With ActiveSheet
  .Range("F3:I28").Delete Shift:=xlToLeft
  .Range("K4:K28").Delete Shift:=xlToLeft
  Set r = .Range(Range("A1"), Range("A1").End(xlDown))
  r.AutoFilter Field:=1, Criteria1:="SSN"
  Set r = r.xlSpecialCells(xlCellTypeVisible)
  .showalldata

  r.Offset(0, 1).Value = "SSN"
  r.Offset(0, 2).Value = ""
  r.Offset(0, 3).Value = "Employee"
  r.Offset(0, 4).Value = ""
  r.Offset(0, 5).Value = "Type"
  r.Offset(0, 6).Value = ""
  r.Offset(0, 7).Value = "Instr"
  r.Offset(0, 8).Value = "Status"
  r.Offset(0, 9).Value = ""
  r.Offset(0, 10).Value = "Date"
  r.Offset(0, 11).Value = "Ticker"
  r.Offset(0, 12).Value = "Source"
  r.Offset(0, 13).Value = ""
  r.Offset(0, 14).Value = "Action"
  r.Offset(0, 15).Value = ""
  r.Offset(0, 16).Value = "Shares"
  r.Offset(0, 17).Value = ""
  r.Offset(0, 18).Value = "Amount"
  r.Offset(0, 19).Value = ""

  With .Range("S1").
    .FormulaR1C1 = "=SUM(C[-1])"
    .NumberFormat = "$#,##0.00"
  End with
  .Columns("C:C").Insert Shift:=xlToRight, _
    CopyOrigin:=xlFormatFromLeftOrAbove
    
'*****Notice I have only used the macro recorder to find and activate the cell I wanna get to so I can do some deleting. (at the end of the document) *****

  set r = Cells.Find(What:="transaction", _
          After:=[red].Range("D4")[/red], LookIn:=xlFormulas, _
          LookAt:=xlPart, SearchOrder:=xlByRows, _
          SearchDirection:=xlNext, _
          MatchCase:=False, SearchFormat:=False)
End with
'*****Now do your deleting with r or r.offset

Gavin

 

[Gavona]

OOPs just tested the code and found two errors.
(i) r.SpecialCells not r.[red]xl[/red]specialcells so change the line to:
Set r = r.SpecialCells(xlCellTypeVisible)

(ii) I left an extra fullstop/period. This should be removed:
With .Range("S1")[red].[/red]



Gavin

 

[fuzzhead1506]

ok.... prolly the last question!

you have been so helpful btw

I am trying not to delete a set of cells at the end of a column that is variable. I think I need to use the xlUp and offset functions in order to reference what I wanna do.

I am guessing it would look like this.

Range("I55555").Select
Range("I4:Selection.End(xlUp).Offset(3,0)").Delete Shift:=xlToLeft

But I get a global error.

can you guys help with this one?

 

[Gavona]

If you have data in every cell in column A within your used range then Range("I55555").End(xlUp) will refer to the same cell as Range("A1").End(xlDown). (Provided you are using less than 55555 rows).

You do not need to Select and then apply an action to the Selection.

Use Range(cell1[red],[/red] cell2), where cell1 and cell2 are Range objects that specify the start and end cells, to return a Range object.

Range("I55555").Select
Range("I4[red]:[/red]Selection.End(xlUp).Offset(3,0)")

is not in the correct format. Try instead:

Range("I4"[red],[/red]   Range("I55555").End(xlUp).Offset(3,0))

Though you may want an offset of -3 rows rather than plus 3.

Gavin

 

[fuzzhead1506]

thank you thank you thank you!!!!!!!!!!!!!!!!!!!!!! =)