VBA Help needed total newbie

[kareny]

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]

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]

Pretty brute force, but I thought it might be easier to follow and to expand/modify if you need to

[vba]
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
[/vba]


Some test data and the macro are attached

Paul

[kareny]

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]

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]

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

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]

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]

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]

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!