PDA

View Full Version : VBA Help needed total newbie



kareny
02-04-2011, 11:35 AM
Hi

I am a total newbie when it comes to VBA. I currently spend around 8 hours a week editing a spreadsheet using cut and paste. The reason for this post is that i know there is an easier way using Macros but i don'e know where to start.

What i need to do is search through the spreadshhet for any cell which contains the words 'hotel', 'htl', 'apartments' or 'Apts'. i then need htese cells to move 3 rows left and one cell down.

what is the easiest way to do this?

If i haven't explained myself very well please let me know.

Thanks in advance

stanleydgrom
02-04-2011, 12:40 PM
kareny,

Welcome to the VBA Express forum.

To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.


Have a great day,
Stan

Paul_Hossler
02-04-2011, 12:51 PM
Pretty brute force, but I thought it might be easier to follow and to expand/modify if you need to


Option Explicit
Sub MoveSomeData()
Dim rCell As Range, rTextData As Range
Dim iRow As Long, iCol As Long
Dim sSheetName As String
Dim wsCopy As Worksheet

Application.ScreenUpdating = False

sSheetName = ActiveSheet.Name

'copy activesheet and give it a new name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(ActiveSheet.Name & "-Copy").Delete
Application.DisplayAlerts = True

ActiveSheet.Copy after:=ActiveSheet
Set wsCopy = ActiveSheet
wsCopy.Name = sSheetName & "-Copy"
On Error GoTo 0

'setup to move cells
Set rTextData = Nothing
On Error Resume Next
Set rTextData = wsCopy.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

'justin case there isn't any
If rTextData Is Nothing Then Exit Sub

For Each rCell In rTextData.Cells
With rCell
If InStr(LCase(.Value), "hotel") > 0 Then
wsCopy.Cells(.Row + 1, .Column + 3).Value = .Value
.ClearContents
ElseIf InStr(LCase(.Value), "htl") > 0 Then
wsCopy.Cells(.Row + 1, .Column + 3).Value = .Value
.ClearContents
ElseIf InStr(LCase(.Value), "apartment") > 0 Then
wsCopy.Cells(.Row + 1, .Column + 3).Value = .Value
.ClearContents
ElseIf InStr(LCase(.Value), "apt") > 0 Then
wsCopy.Cells(.Row + 1, .Column + 3).Value = .Value
.ClearContents
End If
End With
Next

Application.ScreenUpdating = True
End Sub



Some test data and the macro are attached

Paul

kareny
02-05-2011, 02:34 AM
Hi

File attached

There is more to change than I originally posted, I am hoping that if I can get help on the first bit I can try to work out the rest!! If not I'll be back

kareny
02-05-2011, 03:17 AM
Thanks Paul

It Worked!!

Next question....

Is there a way to make the 'Hotel' etc cell copy down until it gets to a cell with data in it?

Paul_Hossler
02-05-2011, 12:08 PM
Is there a way to make the 'Hotel' etc cell copy down until it gets to a cell with data in it?


Of course it can ... this is Excel .. Excel can do ANYTHING :rotlaugh:

However, you need to define when to stop, meaning that if the "Hotel" cell is the lasted used cell in the column, you'd fill down to row 1,000,000

Paul

kareny
02-07-2011, 05:21 AM
Would the this argument work?
If cell in column A contains 'hotel', 'htl', 'apartments', 'apts', 'chalet' fill down until cell in column A contains 'hotel', 'htl', 'apartments', 'apts', 'chalet'.?

What would I need to write to get it to fill down?

Paul_Hossler
02-07-2011, 06:21 AM
Before:

A1 = HOTEL
A50 = HOTEL
A100 = HOTEL


After:

A1 to A49
A50 to A99
A100 to ??????

So, how would you tell the A100 when to stop?

Rest is easy

Paul

kareny
02-07-2011, 06:30 AM
When the report extracts it puts a produced date in Column C. this is the bottom of the report. So theoretically it should be able to stop copying when the cell in the same row in column C = Produced but I have no idea how to make that happen!