VBA Line and intersect

[mrmrf]

Hi

Looking to see how I could utilise VBA code to draw a vertical line from a defined range (say cell B1=0, B2=1000) then horizontally intersect the vertical line down the page, to scale, from a value in another cell.

For example, the vertical line would cover cells A1-A20, with A1 value =0 and A20 Value = 1000 obtained from B1 and B2. The value in cell C1 could be any value from 0-1000 but for the example say 500. The VBA code would then place a horizontal line intersection at the half way point with a label of the horizontal line.

Thanks.

 

[mrmrf]

Thanks DanteAmor!

 

[mrmrf]

Hi DanteAmor.

Any tips on scaling the text box based on the interesect above?

i.e if the first intersect is 0-300, and the second is 300-1000.

I have been trying using a number of things, but only having luck setting a fixed scaleheight, which wouldnt suit when changing the first interesect on another attempt if lines deleted.

Thanks.

https://ibb.co/HtHQNdR

​

Private Sub CommandButton2_Click()
    Dim wL As Shape, c1 As Range, cell1 As String, cell2 As String
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    Dim wTotal As Double, wPoint As Double, wInter As Double
    Dim alto As Double
    
    On Error Resume Next
    On Error GoTo 0
    
    Set c1 = Range("A:A").Find(Range("AJ1").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not c1 Is Nothing Then
        cell1 = c1.Address
        Set c1 = Range("A:A").Find(Range("AJ2").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c1 Is Nothing Then
            cell2 = c1.Address
                        
            x1 = Range(cell1).Left + Range(cell1).Width / 2
            y1 = Range(cell1).Top + Range(cell1).Height
            
            x2 = x1
            y2 = Range(cell2).Top
            
            wTotal = Range("AJ1") + Range("AJ2")
            wPoint = Range("AK1").Value / wTotal
            wInter = (y2 + y1) * wPoint
            
            Set wL = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1, x2, y2)
                wL.Line.Weight = 1
                wL.Line.ForeColor.RGB = RGB(0, 0, 0)
                wL.Name = "Line1"
        
            Set wL = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, wInter, x1 + 20, wInter)
                wL.Line.Weight = 1
                wL.Line.ForeColor.RGB = RGB(0, 0, 0)
                wL.Name = "Line2"
                
            alto = (wInter - y1) - 6
            Set wL = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x1 + 3, y1 + 3, 290, alto)
               wL.TextFrame.Characters.Text = "LAYER 2"
               wL.ScaleHeight 0.1595115118, msoFalse, _
                msoScaleFromBottomRight
                wL.Name = "Line3"
                
                
    Set c1 = Range("A:A").Find(Range("AF1").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not c1 Is Nothing Then
        cell1 = c1.Address
        Set c1 = Range("A:A").Find(Range("AF2").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c1 Is Nothing Then
            cell2 = c1.Address
                        
            x1 = Range(cell1).Left + Range(cell1).Width / 2
            y1 = Range(cell1).Top + Range(cell1).Height
            
            x2 = x1
            y2 = Range(cell2).Top
            
            wTotal = Range("AF1") + Range("AF2")
            wPoint = Range("AG1").Value / wTotal
            wInter = (y2 + y1) * wPoint
            
            Set wL = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, y1, x2, y2)
                wL.Line.Weight = 1
                wL.Line.ForeColor.RGB = RGB(0, 0, 0)
                wL.Name = "Line1"
        
            Set wL = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x1, wInter, x1 + 20, wInter)
                wL.Line.Weight = 1
                wL.Line.ForeColor.RGB = RGB(0, 0, 0)
                wL.Name = "Line2"
                
            alto = (wInter - y1) - 6
            Set wL = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x1 + 3, y1 + 3, 290, alto)
                wL.TextFrame.Characters.Text = "LAYER 1"
                wL.Name = "Line3"
        
                 
                  End If
                  End If
                  End If
                  
    End If
End Sub

 

[DanteAmor]

Hi DanteAmor.

Any tips on scaling the text box based on the interesect above?

i.e if the first intersect is 0-300, and the second is 300-1000.

I have been trying using a number of things, but only having luck setting a fixed scaleheight, which wouldnt suit when changing the first interesect on another attempt if lines deleted.

Thanks.

https://ibb.co/HtHQNdR

​

Set wL = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x1 + 3, [COLOR=#ff0000]y1[/COLOR] + 3, 290, alto)

In that line the beginning of the figure is established on y1
The start is equal to cell1 and cell1 is equal to the top of the first cell found.
In this case it must be 300

 

[mrmrf]

Hi All

Having trouble changing a function to lookup rather than match.

In column AA i have

A1=0
A2=100
A3=200

In cells "AJ1" and "C3" are values for example 100 and 200

The following is used to draw an object/line by matching values in AJ1 or C3 to the exact value in column A to begin to create the line

Set c1 = Range("A:A").Find(Range("AJ1").Value, LookIn:=xlValues, lookat:=xlWhole)
Set c2 = Range("A:A").Find(Range("C3").Value, LookIn:=xlValues, lookat:=xlWhole)

I am trying to change the set c1 and set c2 to lookup a value rather than match. For example if C3 was 150, the line would begin between the values 100 and 200 in column AA

I have been playing with a lookup function with no luck.

Thanks!