Getting error and need help to make this code better for FLP

T

trustmeasfrnd

New Member
Joined
Oct 19, 2008
Messages
32
hi,
i am getting problem when i call userform.
it seems i am missing something and getting object .
when i call userform it appears and when i try to submit that i get error,is that some old version and new version issue or something else how to solve this error. i am now using Excel-2010.
i think this long coding can be reduced can anyone help and solve this issue.
FLP is foundation loading Plan

thanks and regards,
Abhisekh

Code: 
Private Sub CommandButton1_Click()
Sheets("FLP").Cells(5, 2).Value = "FACTOR"
Sheets("FLP").Cells(6, 2).Value = "LOAD CASE / Serial No."
Sheets("FLP").Cells(7, 2).Value = "Joint No."
Sheets("FLP").Cells(7, 3).Value = "Grid Mark"
Sheets("FLP").Cells(2, 1).Value = "Vertical Fy"
Sheets("FLP").Cells(3, 1).Value = "Horizontal Fx"
Sheets("FLP").Cells(4, 1).Value = "Horizontal Fz"
Sheets("FLP").Cells(5, 1).Value = "Moment Mx"
Sheets("FLP").Cells(6, 1).Value = "Moment My"
Sheets("FLP").Cells(7, 1).Value = "Moment Mz"

'' checking whether first load case is entered or not
If Sheets("FLP").Cells(6, 4).Value = "" Then
MsgBox "You Can Not Left First Load Case Blank"
Sheets("FLP").Cells(6, 4).Select
End
End If


''Count No. of Load cases Entered
i = 4
While Sheets("FLP").Cells(6, i).Value <> ""
i = i + 1
Wend

''Print Massage if Factor for any load case is not Entered.
For X = 4 To i - 1
If Sheets("FLP").Cells(5, X).Value = "" Then
MsgBox "You Have Not Entered Factor For Load Case No. " & Sheets("FLP").Cells(6, X).Value
End
End If
Next X

UserForm1.Show
End Sub

Private Sub CommandButton3_Click()
Dim n_load As Integer
Dim i As Integer
Dim Force_type(100) As Integer
Dim load_number(100) As Integer
Dim m As Integer
Dim p As Integer
Dim q As Integer
Dim s As Integer
Dim joint_no As Integer
Dim mrgcol As Integer
Dim ldtypechk As Integer
Dim ldnumchk As Integer
Dim jnt As Integer
Dim ldcs As Integer


Sheets("FLP").Cells(5, 2).Value = "FACTOR"
Sheets("FLP").Cells(6, 2).Value = "LOAD CASE / Serial No."
Sheets("FLP").Cells(7, 2).Value = "Joint No."
Sheets("FLP").Cells(7, 3).Value = "Grid Mark"
Sheets("FLP").Cells(2, 1).Value = "Vertical Fy"
Sheets("FLP").Cells(3, 1).Value = "Horizontal Fx"
Sheets("FLP").Cells(4, 1).Value = "Horizontal Fz"
Sheets("FLP").Cells(5, 1).Value = "Moment Mx"
Sheets("FLP").Cells(6, 1).Value = "Moment My"
Sheets("FLP").Cells(7, 1).Value = "Moment Mz"


''Count No. of Load cases Entered
i = 4
While Sheets("FLP").Cells(6, i).Value <> ""
i = i + 1
Wend

''Print Massage if Factor for any load case is not Entered.
For X = 4 To i - 1
If Sheets("FLP").Cells(5, X).Value = "" Then
MsgBox "You Have Not Entered Factor For Load Case No. " & Sheets("FLP").Cells(6, X).Value
End
End If
Next X

'' checking whether first load case is entered or not
If Sheets("FLP").Cells(6, 4).Value = "" Then
MsgBox "You Can Not Left First Load Case Blank"
Sheets("FLP").Cells(6, 4).Select
End
End If

'''TO CLEAR CONTENTS
Sheets("FLP").Select
    Range("B9:EZ209").Select
    Selection.ClearContents
''*** TO CHECK WHETHER LOAD TYPE IS GIVEN OR NOT
ldtypechk = 4
Do
If (Sheets("FLP").Cells(6, ldtypechk) <> "" And Sheets("FLP").Cells(8, ldtypechk) = "") Then
MsgBox "Select Load Type For Load Seriol No." & Sheets("FLP").Cells(6, ldtypechk)


End
End If
        If Sheets("FLP").Cells(6, ldtypechk) = "" Then
        Exit Do
        End If
 ldtypechk = ldtypechk + 1
Loop
''''--------- To Delete unneccessary load type
ldtypechk = 4
Do
If Sheets("FLP").Cells(6, ldtypechk) = "" And Sheets("FLP").Cells(8, ldtypechk) <> "" Then
Sheets("FLP").Cells(8, ldtypechk) = ""
End If
ldtypechk = ldtypechk + 1
    If ldtypechk = 204 Then
    Exit Do
    End If
Loop
'''------------------------------

                            m = 4
                            Do
                            load_number(m) = Sheets("FLP").Cells(6, m).Value
                            If Sheets("FLP").Cells(6, m).Value = "" Then
                            Exit Do
                            End If
                            m = m + 1
                            Loop
                            
                          


n = 4
Do
            If Sheets("FLP").Cells(8, n).Value = "Horizontal Fx" Then
            Force_type(n) = 3
            End If
                If Sheets("FLP").Cells(8, n).Value = "Vertical Fy" Then
                Force_type(n) = 4
                End If
            If Sheets("FLP").Cells(8, n).Value = "Horizontal Fz" Then
            Force_type(n) = 5
            End If
                If Sheets("FLP").Cells(8, n).Value = "Moment Mx" Then
                Force_type(n) = 6
                End If
            If Sheets("FLP").Cells(8, n).Value = "Moment My" Then
            Force_type(n) = 7
            End If
                If Sheets("FLP").Cells(8, n).Value = "Moment Mz" Then
                Force_type(n) = 8
                End If
            If Sheets("FLP").Cells(8, n).Value = "" Then
            Exit Do
            End If
n = n + 1
Loop


p = 0
                If Sheets("S_Reaction").Cells(3, 1) = "" Then
                MsgBox "Please Click on New Button First"
                End
                End If
                
                
                 s = 0
                Do
               
                If Sheets("S_Reaction").Cells(s + 5, 1) <> "" Then
                
                n_load = s + 1
                Exit Do
                End If
                s = s + 1
                Loop
                
'''' TO CHECK IF MORE THAN SELECTED LOAD CASE IS WRITTEN IN LOAD CASE OF FLP
ldnumchk = 4
Do
If Sheets("FLP").Cells(6, ldnumchk).Value > s + 1 Then
MsgBox "The Load Seriol No. Can't be " & Sheets("FLP").Cells(6, ldnumchk).Value & ",  Since you Have Selected Only " & s + 1 & " Load Cases From Staad Postprocess"
End
End If
        If Sheets("FLP").Cells(6, ldnumchk).Value = "" Then
        Exit Do
        End If
        
ldnumchk = ldnumchk + 1
Loop

''''""""""""""""""""""""""""""""""""""""""""""""""

joint_no = 0
t = 4
Do
If Sheets("S_Reaction").Cells(t, 1) = "" Then


Exit Do
End If
joint_no = joint_no + 1
t = t + n_load
Loop

i = 0
            Do
            If i = joint_no Then
            Exit Do
            Else


q = 4
Sheets("FLP").Cells(i + 9, 2).Value = Sheets("S_Reaction").Cells(n_load * i + 3 + 1, 1).Value

        Do

Sheets("FLP").Cells(i + 9, q).Value = Sheets("S_Reaction").Cells(n_load * i + 3 + load_number(q), Force_type(q)).Value

        If q = m - 1 Then
        Exit Do
        End If
        q = q + 1
        Loop

        End If
        i = i + 1
        Loop
   
''''FORAMTTING
'---------to unmerge -------------------------------------
If Sheets("S_Reaction").Cells(2, 1) <> 0 Then
        Sheets("FLP").Range(Cells(7, 4), Cells(7, q)).Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    
''' to erase border of all cells
Sheets("FLP").Cells.Select
    Range("C50").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B47").Select
''''follwing coding is to select the area having data and make border


Sheets("FLP").Range(Cells(7, 2), Cells(i + 8, q)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
'''''following coding will merge the consecutive columns of 7th row if the load case is same for both columns.
 mrgcol = 4
            Do
 
          
        If Sheets("FLP").Cells(6, mrgcol + 1) = Sheets("FLP").Cells(6, mrgcol) Then
 Sheets("FLP").Range(Cells(7, mrgcol), Cells(7, mrgcol + 1)).Select
 With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        End With
        Selection.Merge
        End If
                If Sheets("FLP").Cells(6, mrgcol).Value = "" Then
                Exit Do
                End If
         mrgcol = mrgcol + 1
            Loop
 ''##############
End If

'''' for print
Sheets("Print").Select
Sheets("Print").Range("B8:AZ500").Select
Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.RowHeight = 11.25
    Selection.ColumnWidth = 7
    Sheets("Print").Range("B6").Select
    Sheets("FLP").Select
    Range("B6:AZ500").Select
    Selection.Copy
    Sheets("Print").Select
    Sheets("Print").Range("B6").Select
    ActiveSheet.Paste
    ''' MULTIPLYING BY FACTOR FOR FLP
    jnt = 9
    Do
            ldcs = 4
            Do
            Sheets("Print").Cells(jnt, ldcs).Value = (Sheets("FLP").Cells(5, ldcs).Value) * Sheets("FLP").Cells(jnt, ldcs).Value * (-1)
            Sheets("Print").Cells(jnt, ldcs).ColumnWidth = Sheets("FLP").Cells(jnt, ldcs).ColumnWidth
            If ldcs = q Then
            Exit Do
            End If
            ldcs = ldcs + 1
            Loop
    If jnt = i + 8 Then
    Exit Do
    End If
    jnt = jnt + 1
    Loop
  Sheets("Print").Range("B6").Select
  Sheets("Print").Range("B6").ColumnWidth = Sheets("FLP").Range("B6").ColumnWidth
  Sheets("Print").Range("B8").RowHeight = Sheets("FLP").Range("B8").RowHeight
  
   
   Sheets("FLP").Select
   Application.CutCopyMode = False
   Range("B6").Select
         
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
Hi StephenCrump,
The error is "Run-time error 424: object required".
I am not sure how to attach file would ve sent you for better understanding.
thanks and regards,
Abhisekh

Code: 
Private Sub UserForm_Activate()
Spreadsheet1.Cells(2, 1).Select
End Sub


 
Upvote 0
We don't need to see your workbook yet. The code should be sufficient to understand what's happening.

But for future reference if you do want to attach a file, post to a sharing site (e.g. I use box.com) and post the link to this forum.

What is Spreadsheet1? You haven't defined it anywhere in the code you have posted.

Code: 
Private Sub UserForm_Activate()
    
    [COLOR=#ff0000][B]Spreadsheet1[/B][/COLOR].Cells(2, 1).Select

End Sub
 
Upvote 0
hi
Stephen,
sorry for late reply.
I think you look at the excel sheet for better understanding.
there is Help sheet which explain what i wanted to do and normally when i paste reaction in Hidden sheet(S_Reaction) and then in FLP sheet if i click refresh button that works fine.but when i try to get it done by userform i am getting error.
please find attached link for reference.
https://files.fm/u/2rnpef6q

thanks and regards,
Abhisekh

StephenCrump said:
We don't need to see your workbook yet. The code should be sufficient to understand what's happening.

But for future reference if you do want to attach a file, post to a sharing site (e.g. I use box.com) and post the link to this forum.

What is Spreadsheet1? You haven't defined it anywhere in the code you have posted.

Code: 
Private Sub UserForm_Activate()
    
    [COLOR=#ff0000][B]Spreadsheet1[/B][/COLOR].Cells(2, 1).Select

End Sub
Click to expand...
 
Upvote 0
Thanks for posting your workbook.

The immediate problem hasn't changed. Your code refers to Spreadsheet1 in Sub UserForm_Activate, and also in various places in Sub CommandButton1_Click() for UserForm1. But you haven't defined Spreadsheet1.

I am guessing you want Worksheets("FLP")? In which case you could have

Code: 
Dim Spreadsheet1 As Worksheet

' ....

Set Spreadsheet1 = Worksheets("FLP")
 
Upvote 0
hi,Stephen,
i will check it on Monday as when i run it here it gives error "can't find Project or library".
i will try it in office.is there any differences in 2016 and 2013?
code was written in excel 97-03.
the way i am trying to pass values from Userform is ok?
thanks again for quick response.
abhisekh

StephenCrump said:
Thanks for posting your workbook.

The immediate problem hasn't changed. Your code refers to Spreadsheet1 in Sub UserForm_Activate, and also in various places in Sub CommandButton1_Click() for UserForm1. But you haven't defined Spreadsheet1.

I am guessing you want Worksheets("FLP")? In which case you could have

Code: 
Dim Spreadsheet1 As Worksheet

' ....

Set Spreadsheet1 = Worksheets("FLP")
Click to expand...
 
Last edited:
Upvote 0
trustmeasfrnd said:
i will check it on Monday as when i run it here it gives error "can't find Project or library".
Click to expand...

Ahh! Sorry, I have misinterpeted your code. You're using a Userform Spreadsheet Control, and, I'm guessing, have recently updated to Excel 2010.

Your VBA Project will need to include a reference to the Microsoft Office Web Components DLL, which is no longer included in Excel. I believe that if you're still on 32 bit Office, you can instal the Excel 2003 web components: https://www.microsoft.com/en-us/download/details.aspx?id=22276
but I don't have any direct experience with this.

You may get more helpful responses if you start a new thread. I'd suggest using a title like: Userform Spreadsheet Control: Web Components for Excel 2010.
 
Upvote 0
Hi Stephen,
can this procedure be done without userform. i mean i just have another command button which paste copied data to S_Reaction.Or may be that can be included in "NEW" command tab.
thanks and regards,
Abhisekh

StephenCrump said:
Ahh! Sorry, I have misinterpeted your code. You're using a Userform Spreadsheet Control, and, I'm guessing, have recently updated to Excel 2010.

Your VBA Project will need to include a reference to the Microsoft Office Web Components DLL, which is no longer included in Excel. I believe that if you're still on 32 bit Office, you can instal the Excel 2003 web components: https://www.microsoft.com/en-us/download/details.aspx?id=22276
but I don't have any direct experience with this.

You may get more helpful responses if you start a new thread. I'd suggest using a title like: Userform Spreadsheet Control: Web Components for Excel 2010.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
331
RoryA
RoryA
S
  • Solved
VBA code - Borders for Table
Replies
2
Views
223
Spaztic
S
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
325
sspatriots
S
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
504
JayB0730
J
N
  • Solved
Copy headers across sheets no longer works.
Replies
7
Views
413
NoSparks
N

Forum statistics

Threads
1,214,918
Messages
6,122,257
Members
449,075
Latest member
staticfluids

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top