Trying to add an Inputbox in Macro

[Vikas Kumar]

Dear Experts,

I have following macro which split a mastersheet into multiple sheet based on its city,

---

Sub DataSplit_2()
Dim City As String
Dim Lr As Byte
Range("C2").Activate
Do While ActiveCell.Value <> ""
City = ActiveCell.Value
On Error Resume Next
If Sheets(City) Is Nothing Then
On Error GoTo 0
Range("A1").EntireRow.Copy
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Name = City
Sheets("Data").Activate
ActiveCell.EntireRow.Copy
Sheets(City).Activate
ActiveCell.Offset(1, 0).PasteSpecial
Sheets("Data").Activate
Else
ActiveCell.EntireRow.Copy
Sheets(City).Activate
Lr = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & Lr).PasteSpecial
Sheets("Data").Activate
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

---

What im looking now, To just add a inputbox into the code so that whenever i run macro firstly it ask to 'Enter your city name for which you want to splil' and whichever city enters only for those a new worksheet (single) to be created.

One more thing - I do not want to split "Ahmedabad & Mumbai" city so whenever I enter anyone among of them a msgbox should appear stating "You can't split this sheet".

Hope you won't be confuse by above statement.

Also for ease pasting my data's Header,


[TABLE="width: 582"]
<tbody>[TR]
[TD="class: xl63, width: 82"]Zone[/TD]
[TD="class: xl63, width: 82"]Region[/TD]
[TD="class: xl63, width: 98"]City[/TD]
[TD="class: xl63, width: 99"]Product[/TD]
[TD="class: xl63, width: 70"]Qty[/TD]
[TD="class: xl63, width: 72"]Price[/TD]
[TD="class: xl63, width: 79"]Sale (in Rs.)[/TD]
[/TR]
</tbody>[/TABLE]

Any help would be appreciated. Thank in Advance.

 

[Caleeco]

Hello Vikas,

This is untested, but please try the following and let me know if it does what you wish:

Sub DataSplit_2()


Dim City As String, userInput As String
Dim Lr As Long
Dim r As Range, RNG As Range


userInput = InputBox("Enter your city name for which you want to split: ", "User Input")


If userInput = "Mumbai" Or userInput = "Ahmedabad" Then
    MsgBox "You can't split this sheet.", vbCritical, "Error"
    Exit Sub
End If


Lr = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
Set RNG = ActiveSheet.Range("C2:C" & Lr)


On Error Resume Next
For Each r In RNG
City = userInput
    On Error Resume Next
    If Sheets(City) Is Nothing Then
            On Error GoTo 0
            Range("A1").EntireRow.Copy
            Sheets.Add
            Range("A1").PasteSpecial
            ActiveSheet.Name = City
            Sheets("Data").Activate
            ActiveCell.EntireRow.Copy
            Sheets(City).Activate
            ActiveCell.Offset(1, 0).PasteSpecial
            Sheets("Data").Activate
        Else
            ActiveCell.EntireRow.Copy
            Sheets(City).Activate
            Lr = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range("A" & Lr).PasteSpecial
            Sheets("Data").Activate
    End If
Next r


End Sub

Many Thanks
Caleeco

 

[Vikas Kumar]

Thanks for you response Caleeco......But unfortunately it just create a new city whatever is entered in Inputbox and copy only headers also repeat header over Data sheet N number of Time.

Pls rectify this.

 

[Caleeco]

Hello,

Ok, I assumed you wanted to use the existing code. If you do not wish to add a new sheet:

Sub DataSplit_2()


Dim City As String, userInput As String
Dim Lr As Long
Dim r As Range, RNG As Range


userInput = InputBox("Enter your city name for which you want to split: ", "User Input")


If userInput = "Mumbai" Or userInput = "Ahmedabad" Then
    MsgBox "You can't split this sheet.", vbCritical, "Error"
    Exit Sub
End If


Lr = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
Set RNG = ActiveSheet.Range("C2:C" & Lr)


On Error Resume Next
For Each r In RNG
City = userInput
    On Error Resume Next
    If Sheets(City) Is Nothing Then
            'Do Nothing
        Else
            ActiveCell.EntireRow.Copy
            Sheets(City).Activate
            Lr = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range("A" & Lr).PasteSpecial
            Sheets("Data").Activate
    End If
Next r

End Sub

If the above is not working, please explain in words ALL of the steps required, eg:
1. User enters City name into inputbox
2. If City is "Mumbai" or "Ahmedabad", display error message
3. Search column C for each instance of city entered, and copy that line to the sheet already created for that city (finding the last used row each time)

Caleeco
4.

 

[Vikas Kumar]

Hi Caleeco,

Sorry for delay in response!

This one is also not touching the requirement. That's why for better understanding attaching herewith my File.

https://we.tl/W6Dga79KSO

Step by Step:

1. User enters City name into inputbox - User can enter anyone city are available in city column.
2. If City is "Mumbai" or "Ahmedabad", display error message - "You can't split this sheet"

Expecting this is a clear description. Pls let me know if you need anything else.

 

[Caleeco]

Hello Vikas,

The code below does what you describe.

Sub DataSplit_2()
Dim userInput As String
userInput = InputBox("Enter your city name for which you want to split: ", "User Input")
If userInput = "Mumbai" Or userInput = "Ahmedabad" Then
    MsgBox "You can't split this sheet.", vbCritical, "Error"
    Exit Sub
End If
'The rest of the actions you wish to carry out
End Sub

However, could you describe what needs to happen after the user enters a city name? Currently if Mumbai or Ahmedabad are entered, an error is displayed and the macro exits. What needs to happen for other city names?

Thanks
Caleeco

 

[Vikas Kumar]

Hello Vikas,

The code below does what you describe.

Sub DataSplit_2()
Dim userInput As String
userInput = InputBox("Enter your city name for which you want to split: ", "User Input")
If userInput = "Mumbai" Or userInput = "Ahmedabad" Then
    MsgBox "You can't split this sheet.", vbCritical, "Error"
    Exit Sub
End If
'The rest of the actions you wish to carry out
End Sub

However, could you describe what needs to happen after the user enters a city name? Currently if Mumbai or Ahmedabad are entered, an error is displayed and the macro exits. What needs to happen for other city names?

Thanks
Caleeco

After entering city name a new sheet should be created separately based on user input. Suppose If I enter 'chennai' into inputbox a new sheet will create with its name and complete data of chennai city would be entered in that sheet.
[TABLE="width: 98"]
<colgroup><col width="98"></colgroup><tbody>[TR]
[TD="class: xl63, width: 98"][/TD]
[/TR]
</tbody>[/TABLE]

 

[Vikas Kumar]

Any Guess on this pls?

 

[dmt32]

Any Guess on this pls?

Hi,
see if this update to suggested code does what you want

Place code in a STANDARD module & assign to you worksheet object

Sub DataSplit_2()
    
    Dim City As String
    Dim Lr As Long
    Dim Cell As Range, RNG As Range
    
    
    City = InputBox("Enter your city name for which you want to split: ", "User Input")
'cancel pressed
    If StrPtr(City) = 0 Then Exit Sub
    
    If UCase(City) = "MUMBAI" Or UCase(City) = "AHMEDABAD" Then
    
        MsgBox "You can't split this sheet.", vbCritical, "Error"
        
    Else
    
    With Worksheets("Data")
        Lr = .Range("C" & .Rows.Count).End(xlUp).Row
        Set RNG = .Range("C2:C" & Lr)
    End With
    
    Application.ScreenUpdating = False
    On Error Resume Next
    If Sheets(City) Is Nothing Then
        Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = City
        RNG.Parent.Range("A1").EntireRow.Copy Sheets(City).Range("A1")
        Sheets("Data").Activate
    On Error GoTo 0
    
    Else
        Sheets(City).UsedRange.Offset(1, 0).Clear
    End If
    
    For Each Cell In RNG
        If Cell.Value = City Then
            With Sheets(City)
                Cell.EntireRow.Copy .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1)
            End With
        End If
    Next Cell
        
    End If
     Application.ScreenUpdating = True
End Sub

do remember to delete your old code (or rename it) to avoid conflicts.

Dave

 

[Vikas Kumar]

Hi,
see if this update to suggested code does what you want

Place code in a STANDARD module & assign to you worksheet object

Sub DataSplit_2()
    
    Dim City As String
    Dim Lr As Long
    Dim Cell As Range, RNG As Range
    
    
    City = InputBox("Enter your city name for which you want to split: ", "User Input")
'cancel pressed
    If StrPtr(City) = 0 Then Exit Sub
    
    If UCase(City) = "MUMBAI" Or UCase(City) = "AHMEDABAD" Then
    
        MsgBox "You can't split this sheet.", vbCritical, "Error"
        
    Else
    
    With Worksheets("Data")
        Lr = .Range("C" & .Rows.Count).End(xlUp).Row
        Set RNG = .Range("C2:C" & Lr)
    End With
    
    Application.ScreenUpdating = False
    On Error Resume Next
    If Sheets(City) Is Nothing Then
        Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = City
        RNG.Parent.Range("A1").EntireRow.Copy Sheets(City).Range("A1")
        Sheets("Data").Activate
    On Error GoTo 0
    
    Else
        Sheets(City).UsedRange.Offset(1, 0).Clear
    End If
    
    For Each Cell In RNG
        If Cell.Value = City Then
            With Sheets(City)
                Cell.EntireRow.Copy .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1)
            End With
        End If
    Next Cell
        
    End If
     Application.ScreenUpdating = True
End Sub

do remember to delete your old code (or rename it) to avoid conflicts.

Dave

Hi Dave,

This one is doing much better but post splitting the input city, Just copy headers only does not take rest data of entered city.