help me with macro

santoshloka · Oct 11, 2017

i need help with macro ..little urgent

my inention to copy the data from one sheet to another data as well as to create sheet with taking reference of cell value
i have 2 sheets
Abstract
MB-BOQ

Code:

Sub CreateSheetsFromAList()
    Application.ScreenUpdating = False
    Dim MyCell As Range
    Dim MyRange As Range
    Dim MySheetName As String
    Dim MyFormulas As Variant
    Dim wks a worksheet
    
    Set MyRange = Sheets("MB-BOQ").Range("C2:F2")
    


                    Sheets("INPUT").Copy after:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = .Cells(MyRange, 1).Value
                Else
                    Set wks = Nothing
                    MsgBox "Sheets: " & .Cells(MyRange, 1).Value & vbCrLf & vbCrLf & "Already exists!", vbExclamation, "Sheet Exists"
                End If
            End If


   
   If Not wks Is Nothing Then Set wks = Nothing


    For Each MyCell In MyRange
    
        MySheetName = Replace(Replace(MyCell.Value, "*", "x"), "?", "S")
        MyFormulas = Array("='" & MySheetName & "'!$I$65", "", "='" & MySheetName & "'!$I$80", "='" & MySheetName & "'!$I$88", "='" & MySheetName & "'!$I$94", "='" & MySheetName & "'!$I$99", "", "='" & MySheetName & "'!$I$111", "='" & MySheetName & "'!$I$117", "='" & MySheetName & "'!$I$121", "", "='" & MySheetName & "'!$I$127", "='" & MySheetName & "'!$I$132", "='" & MySheetName & "'!$I$134", "='" & MySheetName & "'!$I$135", "='" & MySheetName & "'!$I$138", "='" & MySheetName & "'!$I$141", "='" & MySheetName & "'!$I$144", "", "='" & MySheetName & "'!$I$149", "='" & MySheetName & "'!$I$150", "='" & MySheetName & "'!$I$151", "='" & MySheetName & "'!$I$152", "='" & MySheetName & "'!$I$155", "='" & MySheetName & "'!$I$158", "='" & MySheetName & "'!$I$164", "='" & MySheetName & "'!$I$167", "='" & MySheetName & "'!$I$170", "='" & MySheetName & "'!$I$173", "='" & MySheetName & "'!$I$124", "='" & MySheetName & "'!$I$125", "=1")
        
        If SheetExists(MySheetName) Then
        
        'Sheet already exists: No need to create a new one
        MsgBox "Sheet " & MySheetName & " already exists!", vbOKOnly, "Oops!"
        Else
            Sheets.Add after:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Name = MySheetName ' renames the new worksheet
        End If
        
        MyCell.Offset(3, 0).Resize(32, 1).Formula = Application.Transpose(MyFormulas)   'Enter formulas
        
    Next MyCell
        Application.ScreenUpdating = True
End Sub




 Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet




     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

santoshloka · Oct 17, 2017

here is a workbook link

Here is my project link,please help me i was looking for help from long time

Check Module3 Macro

it need to be fix..

1)u just need to find why input data is not copying in rest of data..only sheets are creating if i run module as well it is linked to "MB-BOQ" sheet when the sheet is created.

2)Input data is not copying in rest of all sheets..

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

Fluff · Oct 17, 2017

Unfortunately, I have no idea what you are trying to do. So will need to explain it.
Also there is nothing in this range

Code:

Set MyRange = Sheets("MB-BOQ").Range("C2:F2")

Secondly you have no If statement as the start of this

Code:

                    Sheets("INPUT").Copy after:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = .Cells(MyRange, 1).Value
                Else
                    Set wks = Nothing
                    MsgBox "Sheets: " & .Cells(MyRange, 1).Value & vbCrLf & vbCrLf & "Already exists!", vbExclamation, "Sheet Exists"
                End If
            End If

santoshloka · Oct 17, 2017

can u please find the link which i have given..i made modification in first code

1)MB-BOQ.range =it is changed from E5:AG5
as well as these range linked to "chainages sheet"A1:A50
2)yu can find INPUT sheet in my file this is a template file
E5:50+000
F5:50+050
these are the sheet names will create by cell reference from "MB-BOQ" sheet.

When the sheet 50+000 sheet is created, as well as copy the Input sheet in 50+000,50+050,50+100... etc as well as u can see module 3 this is the formula which is linked to new genereated sheet by cell refence..this cell reference taking form "MB-BOQ"=E5:AG5.

Code:

MySheetName = Replace(Replace(MyCell.Value, "*", "x"), "?", "S")
        MyFormulas = Array("='" & MySheetName & "'!$I$65", "", "='" & MySheetName & "'!$I$80", "='" & MySheetName & "'!$I$88", "='" & MySheetName & "'!$I$94", "='" & MySheetName & "'!$I$99", "", "='" & MySheetName & "'!$I$111", "='" & MySheetName & "'!$I$117", "='" & MySheetName & "'!$I$121", "", "='" & MySheetName & "'!$I$127", "='" & MySheetName & "'!$I$132", "='" & MySheetName & "'!$I$134", "='" & MySheetName & "'!$I$135", "='" & MySheetName & "'!$I$138", "='" & MySheetName & "'!$I$141", "='" & MySheetName & "'!$I$144", "", "='" & MySheetName & "'!$I$149", "='" & MySheetName & "'!$I$150", "='" & MySheetName & "'!$I$151", "='" & MySheetName & "'!$I$152", "='" & MySheetName & "'!$I$155", "='" & MySheetName & "'!$I$158", "='" & MySheetName & "'!$I$164", "='" & MySheetName & "'!$I$167", "='" & MySheetName & "'!$I$170", "='" & MySheetName & "'!$I$173", "='" & MySheetName & "'!$I$124", "='" & MySheetName & "'!$I$125", "=1")

"Chainage sheet" made for making trials

santoshloka · Oct 17, 2017

another process iam getting array,iteration error(Replace in script)

Code:

Sub CreateSheetsFromAList()    Dim MyCell As Range
    Dim MyRange As Range
    Dim MySheetName As String
    Dim MyFormulas As Variant
    Dim n As Integer
    Dim wks As worksheet
    n = 7
    For Each wks In Worksheets
    Sheets("INPUT").UsedRange.Copy Sheets("Sheet" & n).Range("A1")
    n = n + 1
    Next wks
    
    Set MyRange = Sheets("MB-BOQ").Range("E5:AG5")


    For Each MyCell In Replace(Replace(MyCell.Value, "*", "x"), "?", "S")
    
        MySheetName = Replace(Replace(MyCell.Value, "*", "x"), "?", "S")
        MyFormulas = Array("='" & MySheetName & "'!$I$65", "", "='" & MySheetName & "'!$I$80", "='" & MySheetName & "'!$I$88", "='" & MySheetName & "'!$I$94", "='" & MySheetName & "'!$I$99", "", "='" & MySheetName & "'!$I$111", "='" & MySheetName & "'!$I$117", "='" & MySheetName & "'!$I$121", "", "='" & MySheetName & "'!$I$127", "='" & MySheetName & "'!$I$132", "='" & MySheetName & "'!$I$134", "='" & MySheetName & "'!$I$135", "='" & MySheetName & "'!$I$138", "='" & MySheetName & "'!$I$141", "='" & MySheetName & "'!$I$144", "", "='" & MySheetName & "'!$I$149", "='" & MySheetName & "'!$I$150", "='" & MySheetName & "'!$I$151", "='" & MySheetName & "'!$I$152", "='" & MySheetName & "'!$I$155", "='" & MySheetName & "'!$I$158", "='" & MySheetName & "'!$I$164", "='" & MySheetName & "'!$I$167", "='" & MySheetName & "'!$I$170", "='" & MySheetName & "'!$I$173", "='" & MySheetName & "'!$I$124", "='" & MySheetName & "'!$I$125", "=1")
        
        If SheetExists(MyCell.Value) Then
        
        'Sheet already exists: No need to create a new one
        
        Else
            Sheets.Add after:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Name = MySheetName ' renames the new worksheet
        End If
         'Sheet already exists: No need to create a new one
        MsgBox "Sheet " & MySheetName & " already exists!", vbOKOnly, "Oops!"
        MyCell.Offset(3, 0).Resize(32, 1).Formula = Application.Transpose(MyFormulas)   'Enter formulas
         MsgBox "Sheets: " & .Cells(x, 1).Value & vbCrLf & vbCrLf & "Already exists!", vbExclamation, "Sheet Exists"
    Next MyCell
    
End Sub




 Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As worksheet




     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

Fluff · Oct 17, 2017

Still not 100% sure what you're trying to do, but try this (It replaces all the code in Module 3)

Code:

Sub CreateSheets()
    
    Dim x           As Long
    Dim wks         As Worksheet
    Dim MyFormulas  As Variant
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
      
    With Sheets("MB-BOQ")
        For x = 5 To .Cells(5, Columns.Count).End(xlToLeft).Column
            If Len(.Cells(5, x).Value) > 0 Then
                On Error Resume Next
                Set wks = Sheets(CStr(.Cells(5, x).Value))
                On Error GoTo 0
                If wks Is Nothing Then
                    Sheets("INPUT").Copy after:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = .Cells(5, x).Value
                    Set wks = ActiveSheet
                    MyFormulas = Array("='" & wks.Name & "'!$I$65", "", "='" & wks.Name & "'!$I$80", "='" & wks.Name & "'!$I$88", "='" & wks.Name & "'!$I$94", "='" & wks.Name & "'!$I$99", "", "='" & wks.Name & "'!$I$111", "='" & wks.Name & "'!$I$117", "='" & wks.Name & "'!$I$121", "", "='" & wks.Name & "'!$I$127", "='" & wks.Name & "'!$I$132", "='" & wks.Name & "'!$I$134", "='" & wks.Name & "'!$I$135", "='" & wks.Name & "'!$I$138", "='" & wks.Name & "'!$I$141", "='" & wks.Name & "'!$I$144", "", "='" & wks.Name & "'!$I$149", "='" & wks.Name & "'!$I$150", "='" & wks.Name & "'!$I$151", "='" & wks.Name & "'!$I$152", "='" & wks.Name & "'!$I$155", "='" & wks.Name & "'!$I$158", "='" & wks.Name & "'!$I$164", "='" & wks.Name & "'!$I$167", "='" & wks.Name & "'!$I$170", "='" & wks.Name & "'!$I$173", "='" & wks.Name & "'!$I$124", "='" & wks.Name & "'!$I$125", "=1")
                    .Range("A9").Offset(, x - 1).Resize(32, 1).Formula = Application.Transpose(MyFormulas)
                Else
                    MsgBox "Sheets: " & .Cells(5, x).Value & vbCrLf & vbCrLf & "Already exists!", vbExclamation, "Sheet Exists"
                End If
            End If
            Set wks = Nothing
        Next x
    End With
    
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

santoshloka · Oct 17, 2017

many thanks man..this is what iam looking..
little more favour

Check E9,E11,E12 in "MB-BOQ sheet" it is coming right corner.is it possible to set it center position

"Your Code working fine"

Fluff · Oct 17, 2017

Glad to help & thanks for the feedback.

As for the alignment, that's down to your custom formatting

santoshloka · Oct 17, 2017

as well as check in "Home sheet" List box is there(Q,R,S,T Location) box is in transparent (Properties)
it is not updating automaticatically
is it possible to get the all sheet tabs in List box by event procedure
(or)
by clicking command button?

Custom formatting not working where i need to do custom settings?
when module runs custom settings are changed ..it is not in fixed position..can u please solve this

Fluff · Oct 17, 2017

Simply remove the word Private from the start of the sub

help me with macro

santoshloka

Board Regular

Excel Facts

santoshloka

Board Regular

Fluff

MrExcel MVP, Moderator

santoshloka

Board Regular

santoshloka

Board Regular

Fluff

MrExcel MVP, Moderator

santoshloka

Board Regular

Fluff

MrExcel MVP, Moderator

santoshloka

Board Regular

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

help me with macro

Board Regular

Excel Facts

Board Regular

MrExcel MVP, Moderator

Board Regular

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock