Changing from looping sequence to active cell

rcb007

Board Regular
Joined
Nov 12, 2020
Messages
90
Office Version
  1. 365
Platform
  1. Windows
I am trying to reconfigure this instead of going through all the rows within a column to just use the active cells row.

Currently, the routine will look though Column C 13 down, It will find the last value within Column C and then string the C Cell and the Next cell to the right (If a value is there) and string them together.

I hope this kind of makes some sense.

Ultimately I would like to Select a Cell Value in Column C and then have it string the Cell Value in D, finally, Send that value to the CAD Command.
Basically taking the below and modifying it to follow the above statement somehow lol.
VBA Code:
        'Loop through all the rows of the sheet that contain commands.
        For i = 13 To LastRow
           
            'Find the last column.
            LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
           
            'Check if there is at least on command in each row.
            If LastColumn > 2 Then
               
                'Create a string that incorporates all the commands that exist in each row.
                acadCmd = ""
                For j = 3 To LastColumn
                    If Not IsEmpty(.Cells(i, j).Value) Then
                        acadCmd = acadCmd & .Cells(i, j).Value & vbCr
                    End If
                Next j
                
                'Send Command to AutoCAD.
                If Val(acadApp.Version) < 20 Then
                Else
                    acadDoc.SendCommand acadCmd & vbCr
                End If
           
            End If
           
            Sleep 20
           
        Next i

Send AutoCAD Commands From Excel & VBA CLEANEDUP.xlsm
ABCD
12No.CommandArgument 1
131z2s05
142
153
164
175
186
197
208
219
2210
2311
2412
2513
2614
2715
Sheet1


Full Routine
VBA Code:
Option Explicit

'Declaring the API Sleep subroutine.
#If VBA7 And Win64 Then
    'For 64 bit Excel.
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    'For 32 bit Excel.
    'Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Sub SendCommands()

    Dim acadApp     As Object
    Dim acadDoc     As Object
    Dim acadCmd     As String
    Dim sht         As Worksheet
    Dim LastRow     As Long
    Dim LastColumn  As Integer
    Dim i           As Long
    Dim j           As Integer
   

    Set sht = ThisWorkbook.Sheets("Sheet1")
   
    'Activate the Send AutoCAD Commands sheet and find the last row.
    With sht
        .Activate
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
       
        '<<<----- How could I get this to be the Active Column and Cell?
       
       
    End With
       
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    If acadApp Is Nothing Then
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
    End If
    On Error GoTo 0

    With sht
   

        'Loop through all the rows of the sheet that contain commands.
        For i = 13 To LastRow
           
            'Find the last column.
            LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
           
            'Check if there is at least on command in each row.
            If LastColumn > 2 Then
               
                'Create a string that incorporates all the commands that exist in each row.
                acadCmd = ""
                For j = 3 To LastColumn
                    If Not IsEmpty(.Cells(i, j).Value) Then
                        acadCmd = acadCmd & .Cells(i, j).Value & vbCr
                    End If
                Next j
                
                'Send Command to AutoCAD.
                If Val(acadApp.Version) < 20 Then
                Else
                    acadDoc.SendCommand acadCmd & vbCr
                End If
           
            End If
           
            Sleep 20
           
        Next i
       
    End With
         
End Sub

Thank you for any help guys!
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
@rcb007 Not tested but does this help.

VBA Code:
Option Explicit

'Declaring the API Sleep subroutine.
#If VBA7 And Win64 Then
    'For 64 bit Excel.
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    'For 32 bit Excel.
    'Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Sub SendCommands()

    Dim acadApp     As Object
    Dim acadDoc     As Object
    Dim acadCmd     As String
    Dim sht         As Worksheet
    Dim LastRow     As Long
    Dim LastColumn  As Integer
    Dim i           As Long
    Dim j           As Integer


Set sht = ThisWorkbook.Sheets("Sheet1")
   
    'Activate the Send AutoCAD Commands sheet and find the last row.
    With sht
        .Activate
      'check if active cell is in column C  if not then exit  * or maybe do some other action?
      If Intersect(.Range("C:C"), ActiveCell) Is Nothing Then Exit Sub
     'otherwise it is column C so do stuff...
     
    i = ActiveCell.row
    
           
            'Find the last column.
            LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
           
            'Check if there is at least on command in each row.
            If LastColumn > 2 Then
               
                'Create a string that incorporates all the commands that exist in each row.
                acadCmd = ""
                For j = 3 To LastColumn
                    If Not IsEmpty(.Cells(i, j).Value) Then
                        acadCmd = acadCmd & .Cells(i, j).Value & vbCr
                    End If
                Next j
                
                'Send Command to AutoCAD.
                If Val(acadApp.Version) < 20 Then
                Else
                    acadDoc.SendCommand acadCmd & vbCr
                End If
           
            End If
           
            Sleep 20
           
    
    End With
       
End Sub
 
Upvote 0
Thank you! I did get a chance to plug this in. I like how small the amount of code is :).
I filled column C with D with more data (Column C has the same command, however Column D has different numbers.
I placed my cursor in active cell C27 and ran the routine. When doing so, it ran from C27 and everything above that.

Can it be possibly to just use the values in Column C Row 27 relationship?

Again, its working as a whole which is great!

Basically, I have manhole numbers, I want to select the Manhole Number and it zooms to it within CAD.
When I run it the way you have it, it zooms to all the other numbers really quick lol.
 
Upvote 0
I have no understanding of the bits of code that you are using to communicate with the CAD system.
In modifying your original code, I have removed the i loop that was looping through rows. It should now just run once, for the row of the single cell selection you have made in column C. It does loop through j columns to create a string that is the combination of strings in C, D, E... etc to the right.
I cannot see how the code that I have given you executes more than the one time!
 
Upvote 0
Thank you for your help! I think follow you on it.
 
Upvote 0
How would i be able to adjust the code if i wanted to add an active cell in column A. then within the same row, it would continue the below command?

For example, currently i place an active cell in column C10 and then run the command it works.
If I place an active cell in Column A10, how can get it to still run C10 and the command?

VBA Code:
...

  With sht
        .Activate
      'check if active cell is in column C  if not then exit  * or maybe do some other action?
      If Intersect(.Range("C:C"), ActiveCell) Is Nothing Then Exit Sub
     'otherwise it is column C so do stuff...
     
    i = ActiveCell.row

...

I hope that is not to confusing.
 
Upvote 0
If you want no restriction on which column is accept able for activecell then delete the 'If Intersect(.Range...... line

If wanting only A then change C:C to A:A
VBA Code:
If Intersect(.Range("A:A"), ActiveCell) Is Nothing Then Exit Sub

IF A:A or C:C then

VBA Code:
With sht
        .Activate
      'check if active cell is in column A or C  if not then exit
      If Intersect(.Range("A:A"), ActiveCell) Is Nothing And Intersect(.Range("C:C"), ActiveCell) Is Nothing Then Exit Sub
     'otherwise it is column A or C so do stuff...
     
    i = ActiveCell.row

If columns A,B or C then

VBA Code:
If Intersect(.Range("A:C"), ActiveCell) Is Nothing Then Exit Sub
 
Upvote 0
Awesome... That makes alot of sense now. Thank you again for the clarification and help!!
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,296
Members
448,564
Latest member
ED38

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