?
Solved

Manipulating an excel spreadsheet using VBA

Posted on 2011-10-10
14
Medium Priority
?
250 Views
Last Modified: 2012-05-12
In the following snippet of an excel spreadsheet, I have a row starting with 12. I want to move that rows values down to the next row so all of the data would be in one continuous line. This is just one of many rows I want to do this for.

12            R12                 
                       $36.47
0
Comment
Question by:smm6809
  • 7
  • 3
  • 2
  • +2
14 Comments
 
LVL 12

Expert Comment

by:viralypatel
ID: 36942218
use this macro to delete the empty cells and u'll get what u want:
http://dmcritchie.mvps.org/excel/delempty.htm
0
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 36942266

Can you please be more clear about what you are trying to do...

0
 

Author Comment

by:smm6809
ID: 36942389
Sure sorry. I have data in an excel spreadsheet that has 4 columns.
The first 2 column values are one row above the other 2. For example:

the values 12 and R12 are in row 8, but the dollar amounts associated with them are in rows 9, 10, and 11. I want to use VBA to move the data in row 8 to row 9 and then delete row 8.  That is the simplified version, but the sheet reads that way throughout. So in row 12 I have the same situation. I need to move the data in that row down to row 13 and delete row 12. I am using ADO to export this data into an Access database.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 24

Expert Comment

by:StephenJR
ID: 36942474
When you say rows 9,10,11 do you mean columns? Could you post a workbook?
0
 

Author Comment

by:smm6809
ID: 36942497
0
 

Author Comment

by:smm6809
ID: 36942510
This is where I'm at code wise but it is not working.
   
Sheets("Import").Activate
    Set strSrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A500").End(xlDown))
    For Each cel In strSrchRng
        If Trim(cel.Value) = "Sum of CLAIMS" Then
           cel.EntireRow.Delete
           cel.Offset(1, 0).Activate
        End If
        If Trim(cel.Value) <> "" Then
            cel.Copy
            LineTotal = cel.Value
            cel.Offset(1, 0) = LineTotal
            cel.Offset(1, 0).Select
            cel.ClearContents
            cel.Offset(2, 0).Select
       Else
       End If
    Next cel
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36942579
Try this:
Sub x()

Dim r As Range

With Columns(2).SpecialCells(xlCellTypeConstants)
    For Each r In .Cells
        r.Offset(, -1).Resize(, 2).Cut r.Offset(1, -1)
    Next r
End With

Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

Open in new window

0
 
LVL 4

Expert Comment

by:SafetyFish
ID: 36942629
You've clearly got a good approach. You are setting the range up dynamically and I assume that in your sub definition you are also dimensioning all the variables I see  you using.

The problem I see in your code is that you do not set the _value_ of the cell to a value. I think if you replaced the line, cel.offset(1,0)=LineTotal  with the line, cel.offset(1,0).value = LineTotal then you might have a lot more success. Why do you select other cells twice?

The Else line in your code is not necessary, but if you are planning to put more code in then I understand.

One thing that might make your code simpler is to use a Select Case... End Select construct instead of a series of If..Else..Then constructs in your loop. See below:
Sheets("Import").Activate
    Set strSrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A500").End(xlDown))
    For Each cel In strSrchRng
		Select Case Trim(cel.value)
        
			Case "Sum of CLAIMS"
				cel.EntireRow.Delete
				cel.Offset(1, 0).Activate
			Case "" 
				cel.Copy
				LineTotal = cel.Value
				cel.Offset(1, 0).value = LineTotal
				'One option for you might be to forego the two lines above for:
				'cel.offset(1,0).value = cel.value
				'Then just clear the cel contents as you have below and go on.
				cel.Offset(1, 0).Select 'why select this cell?
				cel.ClearContents
				cel.Offset(2, 0).Select 'why select this cell, too?
			Case Else
				'whatever else you're planning
       End Select

Open in new window

0
 

Author Comment

by:smm6809
ID: 36942665
I've attached the spreadsheet, showing on sheet 1 my explanation of what should happen, sheet 2 what your code did, and sheet 3 what I actually want the sheet to look like
Book1.xls
0
 

Author Comment

by:smm6809
ID: 36942726
           Case "Sum of CLAIMS"
                cel.EntireRow.Delete
                cel.Offset(1, 0).Activate
On the Offset line I get an error Object required.

Also, I was using the select because as in your code, I successfully copy the #12 down a row and clear the contents above, but then when I hit the " Next cel" part of the code, it goes to the new #12 cel. It doesn't move to the next cell. So it continually copies the number 12 down the rows. Make sense?
0
 

Author Comment

by:smm6809
ID: 36942789
Just so everyone is clear:
The second copy of Book1 that I sent was in reference to StephenJR's code. The last comment was to Safetyfish. Also Safetyfish, in the select statement I changed Case ""  to Case <>"" as I want the rows with data in them.
0
 
LVL 4

Accepted Solution

by:
SafetyFish earned 2000 total points
ID: 36942802
You get that error because you just deleted the object, cel, in question. Does that make sense? There is no need to activate anything, the select case construct will exit and then you will go to the next "cel" in the For range.

As for #12 getting copied down endlessly, see below:
 
Dim boolSkip as boolean  'define a boolean variable to make sure cells that have been correctly modified are not used to modify further cells
boolskip = false 'set the initial value  
Sheets("Import").Activate
    Set strSrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A500").End(xlDown))
    For Each cel In strSrchRng
		If boolskip = false then
			Select Case Trim(cel.value)
        
				Case "Sum of CLAIMS"
					cel.EntireRow.Delete
					cel.Offset(1, 0).Activate
				Case "" 
					cel.Copy
					LineTotal = cel.Value
					cel.Offset(1, 0).value = LineTotal
					'One option for you might be to forego the two lines above for:
					'cel.offset(1,0).value = cel.value
					'Then just clear the cel contents as you have below and go on.
					cel.Offset(1, 0).Select 'why select this cell?
					cel.ClearContents
					cel.Offset(2, 0).Select 'why select this cell, too?
					boolskip = true 'make sure you skip the cell that has just been modified
				Case Else
					'whatever else you're planning
			End Select
		else
			boolskip = false 'make sure only one cell gets skipped
		end if
	next cel

Open in new window

0
 
LVL 4

Expert Comment

by:SafetyFish
ID: 36942804
Ooops, sorry, sloppy copy and paste. My bad.
0
 

Author Closing Comment

by:smm6809
ID: 36942821
Thanks SafetyFish! I was close but couldn't get past the next cel not doing what I wanted!
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question