[RESOLVED] Stuck with some Visual Basic coding

[Carl1993]

Hi all,

First of all I would like to apologise if this is in the wrong forum, I am new here and I wasn't 100% sure if this was the correct place to post.

Basically my issue is, is that. I have values in percentages, thing is, I have the tabs named as "Prospect" (Sheet1), "Pipeline" (Sheet2) and "Closed" (Sheet3) long story short, if the values are above 50% but under 100% then it needs to be in Sheet 2, so I need to copy that whole row of information that comes with the Percentage and paste it into sheet2. If it's 100% then it needs to be in Sheet3, and if it's under 50% it needs to be into sheet1. Regardless of which sheet I change it in, I need it to move automatically depending on what the value is, and into the correct sheet. So far I have

Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Column = 2) Then
If (ActiveSheet.Name = "Sheet1") Then
If ((Target.Text = "") = False) Then
If (Target.Value >= 0 And Target.Value <= 0.5) Then
' Do nothing, we're already in Sheet1
ElseIf (Target.Value > 0.5 And Target.Value < 0.99) Then
' Get the row number of the modified cell
Dim targetRowNum As Integer
targetRowNum = Target.Row

' Select and copy the modified row
Rows(targetRowNum).Select
Selection.Cut

' Get and store the first empty row in Sheet2
Dim emptyRowNum As Integer
emptyRowNum = GetEmptyRowNum("Sheet2")

' Select the empty row and paste the row
Sheet2.Activate
Sheet2.Rows(emptyRowNum).Select
Sheet2.Paste

' Move the rows under the modified row up one space
Sheet1.Activate
Dim rowShift As Range
Set rowShift = Range("A" & targetRowNum + 1, "Z" & targetRowNum + 1000)
rowShift.Cut
Cells(targetRowNum, 1).Select
ActiveSheet.Paste
Cells(targetRowNum, 2).Select
ElseIf (Target.Value = 1) Then

End If
End If
ElseIf (ActiveSheet.Name = "Sheet2") Then

Else

End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Column = 2) Then
If (ActiveSheet.Name = "Sheet2") Then
If ((Target.Text = "") = False) Then
If (Target.Value >= 0.5 And Target.Value <= 0.99) Then
'Do nothing, we're already in Sheet2
ElseIf (Target.Value > 0.99 And Target.Value < 1) Then
'Get the row number of the modified cell
Dim targetRowNum As Integer
targetRowNum = Target.Row

'Select and copy the modified row
Rows(targetRowNum).Select
Selection.Cut

'Get and store th first empty row in Sheet2
Dim emptyRowNum As Integer
emptyRowNum = GetEmptyRowNum("Sheet3")

'Select the empty row and paste the row
Sheet3.Activate
Sheet3.Rows(emptyRowNum).Select
Sheet3.Paste

End If
End If
ElseIf (ActivateSheet.Name = "Sheet3") Then

Else

End If
End If
End Sub



End Sub
Function GetEmptyRowNum(ByVal sheet As String) As Integer
If (sheet = "Sheet1") Then

ElseIf (sheet = "Sheet2") Then
Dim emptyRowNum As Integer

' Activiate Sheet2 and reset the cell selection
Sheet2.Activate
ActiveSheet.Cells(1, 2).Select

Do
ActiveCell.Offset(1, 0).Select
emptyRowNum = ActiveCell.Row
Loop Until IsEmpty(ActiveCell)

' Select Sheet1
Sheet1.Activate

' Return the empty row number
GetEmptyRowNum = emptyRowNum
Else

End If
End Function

Problem is, I get a compile error when in sheet 1, and changing the value to 100%. I'd like it to go into sheet3. Is there anyone out there that can be of any help? It would be highly appreciated.


Kind Regards,

Carl

[si_the_geek]

Welcome to VBForums

Thread moved to the 'Office Development/VBA' forum... note that while it certainly isn't made clear, the "VB Editor" in Office programs is actually VBA rather than VB, so the 'VB.Net' forum is not apt

[opus]

Welcome to VBForums
Did you change the name of the sheets? (in the coed you still have "Sheet1").

Assuming you changed the names and also assuming an entry in row x will allways remain in that row, even it is moved to another sheet.
In a Module

Public Sub Change(Target As Range)
'I Assume your percentages are all in Column 2!
Dim TargetSheet As String
Dim RowNumber As Integer
If (Target.Column = 2) Then
    Select Case Target.Value
        Case Is < 0.5
            TargetSheet = "Prospect"
        Case Is < 1
            TargetSheet = "Pipeline"
        Case Else
            TargetSheet = "Closed"
    End Select
    If ActiveSheet.Name = TargetSheet Then
        'we are already on the correct sheet!
        Exit Sub
    End If
    RowNumber = Target.Row
    Target.EntireRow.Select
    Application.CutCopyMode = False
    Selection.Cut (Sheets(TargetSheet).Rows(RowNumber))
End If
End Sub

and in each Worksheets Code

Private Sub Worksheet_Change(ByVal Target As Range)
Change Target
End Sub

[opus]

and if you change the last line in the module sub to.

    Selection.Cut (Sheets(TargetSheet).Rows(Sheets(TargetSheet).UsedRange.Rows.Count + 1))

it will always be pasted into a new line (keeping fingers crossed)

[Carl1993]

Thank you for your reply, however I have the names still as Sheet1, Sheet2 etc in the worksheet, so it works along with the code, but thanks for picking up on that. My main issue is that I need a line of code that will only look at the Sheet I am tabbed into, rather than working for the whole workbook. As obviously the values for each sheet will clash of what action to take. So far, I can only have Sheet1 Copy and paste the row, and keeping all of the information in the same columns, but being pasted into the correct row so there are no blank rows.

[opus]

Sorry, but I'm lost on what you really need!
If your need hasn't chaged from your post #1, however the sheet-names are still "Sheet1" etc (you could have changed those names!) and you want to place cut and paste into the first empty row of the other sheet, use my code with this changes.
in a Module

Public Sub Change(Target As Range)
'I Assume your percentages are all in Column 2!
Dim TargetSheet As String
Dim RowNumber As Integer
If (Target.Column = 2) Then
    Select Case Target.Value
        Case Is < 0.5
            TargetSheet = "Sheet1"
        Case Is < 1
            TargetSheet = "Sheet2"
        Case Else
            TargetSheet = "Sheet3"
    End Select
    If ActiveSheet.Name = TargetSheet Then
        'we are already on the correct sheet!
        Exit Sub
    End If
    RowNumber = Target.Row
    Target.EntireRow.Select
    Application.CutCopyMode = False
     Selection.Cut (Sheets(TargetSheet).Rows(Sheets(TargetSheet).UsedRange.Rows.Count + 1))
End If
End Sub

and in each Worksheets Code

Private Sub Worksheet_Change(ByVal Target As Range)
Change Target
End Sub

[Carl1993]

My mistake, thank you very much for your help!

[opus]

If your problem is solved, please mark this thread resolved (using the thread tools above your initial post)