Solved Help with VBA/macro to move rows to various other sheets aut

March 1, 2017 at 04:45:57
Specs: Windows 10
Hi,

Getting familiar with VBA/Macro’s but still new and struggling. I’ve been able to piece together stuff by looking up examples on youtube videos and playing around with other codes posted online but I’m stuck and need major help

I’ve got four sheets on my workbook. All of them have the same layout, the first column is my header and has a filter. All the columns after L are hidden/deleted.

I copy/paste information into the first sheet (Feb – Monitor), from an application, "an example is on the text to column sheet). I have a macro to move everything to the correct columns which is run on the first sheet.

I’d like a macro for the first sheet so that when it’s run, it’ll do the following;

Look at information in column G and move them to the appropriate sheets in the next empty row.

Pending – Move anything that is “DA” or “I” to this sheet
Accepted - Move anything that is “AC” to this sheet
Released – Move anything that is “RL” to this sheet.

One thing to point out, there are blank spaces that appear in some of the cells in column G next to the characters ie “T “ (two blank spaces after T) or “RT “ (one blank space after RT)

For the other sheets, I’d like to know how to modify the code I have in “Module1” to automatically move rows for just the Pending, Accepted, and Released sheets to other sheets once you key in the specific status. I’ve played around with the code and can get it to work but it overwrites the first row instead of moving it an empty row.

Feb - Monitor - Anything keyed in as RT, T, RE, RJ is moved to the first sheet
Pending - Anything keyed in as DA or I moves to this sheet
Accepted - Anything keyed in as AC moves to this sheet.
Released - Anything keyed in as RL moves to this sheet.

Link to the spreadsheet on google drive.
https://drive.google.com/open?id=0B...

Much appreciated


See More: Help with VBA/macro to move rows to various other sheets aut

Report •

#1
March 1, 2017 at 18:26:54
✔ Best Answer
First, I am reluctant to download your workbook because it contains macros. I don't know you and I can't be sure that you haven't included malicious code in the workbook. If you want us to look at the code, please copy and paste it into this forum. Be sure to use the pre tags as explained via the link at the bottom of this post.

As for your questions:

re: "Look at information in column G and move them to the appropriate sheets in the next empty row.

Pending – Move anything that is “DA” or “I” to this sheet
Accepted - Move anything that is “AC” to this sheet
Released – Move anything that is “RL” to this sheet."

I think this code will accomplish your goal or at least get you started:

Sub MoveStuff()
'Determine last row with data in Column G
   lastGrw = Sheets(1).Range("G" & Rows.Count).End(xlUp).Row
'Loop through row in reverse over
  For cutRw = lastGrw To 1 Step -1
'Set Sheet name based on contents of Column G
   Select Case Sheets(1).Range("G" & cutRw)
     Case "DA", "I"
      shtName = "Pending"
     Case "AC"
      shtName = "Accepted"
     Case "RL"
      shtName = "Released"
     Case Else
      GoTo nxt
   End Select
'Determine next empty row in appropriate sheet
    nxtRw = Sheets(shtName).Range("G" & Rows.Count).End(xlUp).Row + 1
'Cut, paste, Delete
      Sheets(1).Range("G" & cutRw).EntireRow.Cut _
        Sheets(shtName).Range("A" & nxtRw)
      Sheets(1).Range("G" & cutRw).EntireRow.Delete
nxt:
  Next
End Sub

re: "One thing to point out, there are blank spaces that appear in some of the cells in column G next to the characters ie “T “ (two blank spaces after T) or “RT “ (one blank space after RT)"

I'm not sure how that relates to what you want to do. Please explain.

re: "I’ve played around with the code and can get it to work but it overwrites the first row instead of moving it an empty row."

The code above includes an instruction to determine the next empty row in a given worksheet.

The instruction looks something like this:

 lastRw = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1

What this does is to tell VBA to look at Sheet1 Column A and go all the way to bottom and then come up until it finds a cell that contains data. Determine that Row number and add 1 to it. That Row number should be the next empty Row in Column A.

I used Column A in this example, but the main thing to remember is to use a Column that you know has data in the last row that you are interested in. i.e. the longest column in your sheet. If you don't know which is the longest column, there are ways to determine that also.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
March 2, 2017 at 20:46:21
Hi,

Thanks for the answer. You can never be too careful, I've uploaded just the spreadsheet again without any macros saved as a .xls file.

https://drive.google.com/open?id=0B...


This is the text to column macro I run to move information to the correct columns, which you can copy/paste to the blank sheet to test out.

Public Sub FormatDelimitedData()
Call LudicrousMode(True)
Dim LastRow As Long: LastRow = GetLastRow(ActiveSheet, 1)
Dim RowCounter As Long, ColCounter As Long
For RowCounter = 2 To LastRow
Dim Storage() As String: Storage = Split(StrConv(Cells(RowCounter, 1).Value, vbUpperCase), Chr(166))
For ColCounter = 0 To UBound(Storage)
Cells(RowCounter, ColCounter + 1).Value = Storage(ColCounter)
Next ColCounter
Next RowCounter
Call LudicrousMode(False)
End Sub

Public Function GetLastRow(ByVal TargetWorksheet As Worksheet, ByVal ColumnNo As Long) As Long
GetLastRow = TargetWorksheet.Cells(TargetWorksheet.Rows.Count, Chr(64 + ColumnNo)).End(xlUp).Row
End Function

Public Sub LudicrousMode(ByVal Toggle As Boolean)
Application.ScreenUpdating = Not Toggle
Application.EnableEvents = Not Toggle
Application.DisplayAlerts = Not Toggle
Application.Calculation = IIf(Toggle, xlCalculationManual, xlCalculationAutomatic)
End Sub


The information, is copy/pasted from a third party software. The status column has empty space characters in some cells ie RT*blank space**blank space*


This is the script to have rows automatically move from the other sheets (PENDING, ACCEPTED, RELEASED) once the status is keyed in. For some reason, it moves the row to the top and overwrites the first row on the other sheets instead of moving to the next empty row.

Sub TransferData()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("G2", Range("G" & Rows.Count).End(xlUp)).AutoFilter 1, "DA"
Range("A2", Range("M" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)
Range("A2", Range("M" & Rows.Count).End(xlUp)).Delete
[I1].AutoFilter

Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


Report •

#3
March 3, 2017 at 03:31:22
It appears that you have simply restated the questions in your original post and included the macros.

Did you read my previous post? Does it answer any of your questions?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
March 10, 2017 at 03:48:07
Hi,

I posted the text to column code so that it would allow you to run it in the blank workbook and give you a much idea of what the cell looks like.

The code you posted works except on cells that have blank spaces after that status. Here is a modified code that removes the blank spaces, is able to read the exact status keyed in and them move the row. Is there anyway to improve on it, it takes a couple of minutes to finish running when if there are move than a couple hundred lines on the other sheets.

Sub MoveToWs()
Dim ws As Worksheet, move As Boolean
Dim ws2 As String, ws2nr As Long
Dim i As Long, lastRow As Long, LastCol As Long


Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets(1)
Sheets(ws.Name).Select
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
move = False


With ActiveSheet
For i = lastRow To 2 Step -1
If Trim(.Cells(i, "G")) = "DA" Or Trim(.Cells(i, "G")) = "I" Then
ws2 = "Pending"
ws2nr = Sheets(ws2).Cells(Rows.Count, "C").End(xlUp).Row + 1
move = True
ElseIf Trim(.Cells(i, "G")) = "AC" Then
ws2 = "Accepted"
ws2nr = Sheets(ws2).Cells(Rows.Count, "C").End(xlUp).Row + 1
move = True
ElseIf Trim(.Cells(i, "G")) = "RL" Then
ws2 = "Released"
ws2nr = Sheets(ws2).Cells(Rows.Count, "C").End(xlUp).Row + 1
move = True
End If
If move = True Then
.Cells(i, LastCol).EntireRow.Cut Sheets(ws2).Range("A" & ws2nr)
.Cells(i, LastCol).EntireRow.Delete
move = False
End If
Next
End With
Application.ScreenUpdating = True


I've got another question, how would I define multiple values on this code?
This will only move rows when "DA" is keyed into cell G to the Pending sheet. How do I add other status to move to other sheets?

Pending – Move anything that is “DA” or “I” to this sheet
Accepted - Move anything that is “AC” to this sheet
Released – Move anything that is “RL” to this sheet."


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lngRow As Long, ws As Worksheet, nextrow As Long

If Target.Cells.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

If Not Intersect(Target, Columns("G:G")) Is Nothing Then
If Target.Value = "DA" Then
lngRow = Target.Row
On Error Resume Next
With ThisWorkbook
Set ws = Worksheets("Pending")
If ws Is Nothing Then .Worksheets.Add().Name = "Pending"
nextrow = Worksheets("Pending").Cells(Rows.Count, "C").End(xlUp).Row + 1
End With
With Sheet1 'code name
.Range("A" & lngRow & ":M" & lngRow).Copy Destination:=Worksheets("Pending").Range("A" & nextrow)
.Range("A" & lngRow).EntireRow.Delete shift:=xlUp
End With
End If
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True
Set ws = Nothing

End Sub



Report •

Ask Question