"LOOP?" to write values in user from to work sheet.

May 12, 2014, 1:53 am

≫ Next: Copy rows to new sheet, based on y/n value in 1st column

≪ Previous: Resize chart when pasting into ppt

$

0

0

Good morning from a struggekling newbie.

In a effort to to control my timber stock I created a user form with 1 text boxes for Date, Supplier and then 7 lines of text boxes, size, lenght, quantity, linear Mt and cost per meter. This data is written to cells G1-G4 with a click botton. All stock is kept in a linear mt format as all timber is not supplied in the same lenghts. With this code

Code:

---

Private Sub Import_Click()
Dim ws As Worksheet
 Set ws = Worksheets("Main Stock Sheet")
 ws.Range("A4") = InPutDate
 ws.Range("B4") = ComBoxVendor
 ws.Range("C4") = ComboBox1.Value
 ws.Range("D4") = Lnght1.Value
 ws.Range("E4") = Qty1.Value
 ws.Range("F4") = Lnght1.Value * Qty1.Value
 ws.Range("G4") = ((Lnght1.Value * Qty1.Value) / TransCost.Value) + (Prc1.Value / ws.Range("F4"))
 
Unload Me
End Sub

---

I am able to write the first line in the user form to the "Main Stock Sheet". How do I create a loop to cycle through the rest of the user form. All the lines in the user form may not always contain data. I would like to write only the lines with data. The data should be written to the first open cell in the work sheet.

Since the smoke is all ready coming out of my ears

There is a delivery cost that need to be divided up and added to the total linear meter. So my last line of code need to change somehow.

Gentelmen and ladies, you are heroes

Rgeards Herco

---

Copy rows to new sheet, based on y/n value in 1st column

May 12, 2014, 2:07 am

≫ Next: data is downloading but is column headers are not displaying please help me out

≪ Previous: "LOOP?" to write values in user from to work sheet.

$

0

0

Hi All,
I'm pulling my hair out (partly cause my VBA skills are nill, and because I know this can be easily done).

I have a single sheet that lists available items, prices, etc. When doing quotes, you simply put y/n in Col:A for each item. I then want a simple macro that will copy all of the rows with "yes" into a second sheet. Sample data with end result attached.

I did try and butcher this macro to do what I want, and whilst it does copy data across, it's not really working. Firstly as I think it is searching along a row and copy columns, whereas I need to search a column and then copy rows.

Code:

---

Sub copyQuote()
    Dim LC As Long, LR As Long, FC As Long, c As Range, rData As Range
    Application.ScreenUpdating = False
    LC = ActiveSheet.Range("A4").End(xlToLeft).Column
    For Each c In Range(Cells(4, 2), Cells(4, LC))
        If c.Value = "y" Then
            FC = Sheets("License").Range("A4").End(xlToLeft).Offset(, 1).Column
        Else
            FC = 1
        End If
        LR = Cells(Rows.Count, c.Column).End(xlUp).Row
        Set rData = Application.Union(c.Offset(1), c.Offset(13).Resize(LR - 5))
        rData.Copy Sheets("Legrand").Cells(1, FC)
    Next c
    Application.ScreenUpdating = True
End Sub

---

Thanx in advance.
sample_data.xls

data is downloading but is column headers are not displaying please help me out

May 12, 2014, 2:08 am

≫ Next: Regarding intersection of two regular polynomials

≪ Previous: Copy rows to new sheet, based on y/n value in 1st column

$

0

0

data is downloading but is column headers are not displaying
i have created table called tblbatch_headers in database

1st (batch headers)column name --> wds next 2nd column as Field1,Field2,Field3,Field4,Field5,Field6,Field7,Field8,Field9,Field10...etc

Code:

---

    Dim cnt As ADODB.Connection
    Dim rst1 As ADODB.Recordset, rst2 As ADODB.Recordset
    Dim stDB As String, stSQL1 As String, stSQL2 As String
    Dim strConn As String
    Dim wbBook As Workbook
    Dim Sheet1 As Worksheet
   
    Dim lnField As Long, lnCount As Long
    Dim dataStr As String
    'Instantiate the ADO-objects.
    Set cnt = New ADODB.Connection
    Set rst1 = New ADODB.Recordset
    Set rst2 = New ADODB.Recordset
   
    Set wbBook = ThisWorkbook
    Set Sheet1 = wbBook.Worksheets(1)
   
    'Path to the database.
    stDB = "mysql32"
   
    'Create the connectionstring.
    strConn = "Driver=MySQL ODBC 5.2 Unicode Driver;" _
    & "Data Source=" & stDB & ";"
   
    'The 1st raw SQL-statement to be executed.
    ' stSQL1 = "SELECT * FROM tblbatch_headers where idBatch " & batchID & "order by col_seq asc"
   
    'The 2nd raw SQL-statement to be executed.
    stSQL2 = "SELECT * FROM  " & InputBox("Enter the Batch Name") & "  where FQR_User_Code='" & Application.username & _
        "' and line_status in('QP') order by line_status" '
    'Clear the worksheet.
    Sheet1.Range("A1:FA1").CurrentRegion.Clear
   
    With cnt
        .Open (strConn)  'Open the connection.
        .CursorLocation = adUseClient 'Necessary to disconnect the recordset.
    End With
   
    With rst1
'      .Open stSQL1, cnt    'Create the recordset.
      Set .ActiveConnection = Nothing 'Disconnect the recordset.
    End With
   
    With rst2
        .Open stSQL2, cnt 'Create the recordset.
        Set .ActiveConnection = Nothing 'Disconnect the recordset.
    End With
   
    With Sheet1
'        .Cells(2, 1).CopyFromRecordset rst1 'Copy the 1st recordset.
        .Cells(3, 1).CopyFromRecordset rst2 'Copy the 2nd recordset.
  End With
   
    'Release objects from the memory.
'    rst1.Close
  '  Set rst1 = Nothing
    rst2.Close
    Set rst2 = Nothing
    cnt.Close
    Set cnt = Nothing
   
End Sub

---

Regarding intersection of two regular polynomials

May 12, 2014, 2:41 am

≫ Next: Conditional copy/paste cell content from one sheet to another

≪ Previous: data is downloading but is column headers are not displaying please help me out

$

0

0

Greetings to everyone here! :)

I have an issue with finding the intersection of 2 regular polynomials (i.e. integer powers for the polynomials) and I hope you guys could help me shed some light on this.

As mentioned, I am currently stuck at a problem involving having to obtain the intersection of two regular polynomials (one of 4th order and one of 2nd order) automatically. I combined both into the 'f(x) = 0' format and tried to use the Bairstow method to try to get the intersection points. I understand that there are several alternatives to solving this, such as finding the differences between the two curves and then using SOLVER or GOAL SEEK to set the difference = 0 by changing the X-Values.

However, that method will not work for me, as I need a way to obtain the intersection points on the basis of a formula. This is because I have a chunk of datarows which has each their own 2 sets of polynomials. For each data row, I need to find its corresponding intersection points and then, use SOLVER or GOALSEEK to minimize the sum of squares error (by changing x-values) compared to another independent data set ('TRUTH') data. I could not do this if I were to simply use Solver to get me the intersection points.

The gist of this, is to obtain an equation to solve the intersection, by means of a formula.

E.g. for 2nd order polynomials: x = [-b +/- SQRT(b²-4ac) ] /2a

I have attached a VBA code based on Bairstow's method, but it seems that I could not obtain the roots. It gave me a #VALUE! error. I managed to compile the VBA code without errors, which is why I'm puzzled with the result.

By the way, is it possible to use Solver while changing a Variable that is derived based on a VBA code?


Thank you all very much in advance for any of your advice/help. I really appreciate it. ;)

Regards
Ben

Attached Files

• Excel Bairstow Macro.txt‎ (5.2 KB) Download

Conditional copy/paste cell content from one sheet to another

May 12, 2014, 2:47 am

≫ Next: To Automatically Sort data based on date

≪ Previous: Regarding intersection of two regular polynomials

$

0

0

Hi basically I need to copy a couple cells from sheet2,3 and 4 to sheet1 depending on value of cell a2 of respective sheets.
I have the basic code here, and what I think I'm missing is the adding row in sheet1. Can anyone help?
The below codes can be all wrong by the way, YES, I do not have much knowledge in Macro.

Your help will be much appreciated.

Code:

---

Sub Transfertosummary()
Dim ssummary As Worksheet
Dim sproject As Worksheet
Dim scs As Worksheet
Dim sadmin As Worksheet

Set ssummary = Sheets("Summary")
Set sproject = Sheets("Project")
Set scs = Sheets("CS")
Set sadmin = Sheets("Admin")

Dim rowcount As Long
Dim rowstart As Long
Dim rowend As Long
Dim pasterow As Long
Dim pasteclmdes As Long
Dim pasteclmstat As Long
Dim pasteclmsdept As Long

rowstart = 3
rowend = 300
pasterow = 4
pasteclmdes = 2
pasteclmstat = 4
pasteclmdept = 3

Activate ssummary
For rowcnt = rowstart To rowend
If sproject.Cells(rowcnt, 7).Value = "Pending" Or sproject.Cells(rowcnt, 7) = "Overdue" Then
Copy sproject.Cells(rowcnt, 4).Value
Paste Cells(pasterow, pasteclmdes)
Copy sproject.Cells(rowcnt, 7).Value
Paste Cells(pasterow, pasteclmstat)
Copy sproject.Cells(1, 1).Value
Paste Cells(pasterow, pasteclmdept)
End

Activate ssummary
For rowcnt = rowstart To rowend
If scs.Cells(rowcnt, 7).Value = "Pending" Or scs.Cells(rowcnt, 7).Value = "Overdue" Then
Copy scs.Cells(rowcnt, 4).Value
Paste Cells(pasterow, pasteclmdes)
Copy scs.Cells(rowcnt, 7).Value
Paste Cells(pasterow, pasteclmstat)
Copy scs.Cells(1, 1).Value
Paste Cells(pasterow, pasteclmdept)
End

Activate ssummary
For rowcnt = rowstart To rowend
If sadmin.Cells(rowcnt, 7).Value = "Pending" Or scs.Cells(rowcnt, 7).Value = "overdue" Then
Copy sadmin.Cells(rowcnt, 4).Value
Paste Cells(pasterow, pasteclmdes)
Copy sadmin.Cells(rowcnt, 7).Value
Paste Cells(pasterow, pasteclmstat)
Copy sadmin.Cells(1, 1).Value
Paste Cells(pasterow, pasteclmdept)
End


End Sub

---

To Automatically Sort data based on date

May 13, 2014, 2:01 am

≫ Next: Macro to take action on all sheets that come after specified sheet

≪ Previous: Conditional copy/paste cell content from one sheet to another

$

0

0

Hi All,

Could someone please help me to sort datas in a report based on Date criteria given in a column.

Sample work sheet attached. Cells to be sorted from range (A19:J48) based on the date values given in column A.

please note these datas are pulled out from other mutliple worksheets based on Emp.no criteria using index & match.

Kindly suggest to fix this using formulas or by macros whichever is simple.

Thanks in advance.

Attached Files

• Book4.xls‎ (29.0 KB) Download

Macro to take action on all sheets that come after specified sheet

May 13, 2014, 2:08 am

≫ Next: Help with vba join split function

≪ Previous: To Automatically Sort data based on date

$

0

0

Hi everyone,

I have an excel Workbook made up of sheets that are named after months ("May 2014", "Jun 2014" etc). I want to pull data from each sheet that comes after a user specified date. Is there any way to do this?

Thanks in advance!

Emma

Help with vba join split function

May 13, 2014, 2:12 am

≫ Next: Listbox and textbox on different forms

≪ Previous: Macro to take action on all sheets that come after specified sheet

$

0

0

Hi everyone,

I am wondering how to modify the below function, or create a new one to achieve the following. Thanks for your help in advance.

Function NextIPAddress(IP As String) As String
Dim Arr As Variant
Arr = Split(IP, ".")
Arr(UBound(Arr)) = Arr(UBound(Arr)) + 10
NextIPAddress = Join(Arr, ".")
End Function

This function will an IP address, such as 1.1.1.1 and turn it into 1.1.1.11, based on the +10 in the line Arr(UBound(Arr)) = Arr(UBound(Arr)) + 10.

I am looking to modify the function to add another value to the third octet of the IP address.

Example: add 20 to the third octet and 10 to the fourth octet for the IP address 1.1.1.1 to turn it into 1.1.21.11

Can this be done?

Thanks!

---

Listbox and textbox on different forms

May 13, 2014, 2:13 am

≫ Next: Set oval size

≪ Previous: Help with vba join split function

$

0

0

Hi
I have a listbox on userform1 with multiselect and i am trying to populate the selection into textbox1 on userform2. Can anyone please advise.

thanks

Set oval size

May 13, 2014, 2:24 am

≫ Next: Add contiguous cells, and put result in the top cell

≪ Previous: Listbox and textbox on different forms

$

0

0

I am tring and failing to set the width of the oval to five times the height. It should be simple but I've changed all the variables and still can't get it. Any help appreciated.

Code:

---

Sub NamesSites()
 Dim shpTemp As Shape
Dim rngData As Range
Dim rngOutput As Range
Dim lngIndex As Long

Set rngData = Range("a6", Cells(Rows.Count, 1).End(xlUp))
Set rngOutput = rngData.Offset(0, 4)

For lngIndex = 1 To rngData.Rows.Count
    With rngOutput.Cells(lngIndex)
        Set shpTemp = ActiveSheet.Shapes.AddShape(msoShapeOval, _
                            .Left + ((.Width - .Height) / 2) + 2, _
                            .Top + 1, _
                            .Height - 2, _
                            .Height - 2)
    End With
   
    With shpTemp
        .Name = rngData.Cells(lngIndex).Offset(0, 0)
        ActiveSheet.DrawingObjects(shpTemp.Name).Formula = "=" & rngData.Cells(lngIndex).Address
        With .TextFrame
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
            .Characters.Font.Size = 8
            .Characters.Font.Color = vbWhite
        End With
    End With
Next
End Sub

---

Add contiguous cells, and put result in the top cell

May 13, 2014, 2:25 am

≫ Next: Create variable using match function

≪ Previous: Set oval size

$

0

0

Hi,
I was wondering if there was a formula or VBA code to add all contiguous numbers and to post the answer to the topmost cell upto that point and delete the other cells.

For example: The column of the left should be converted into the column on the right.

1 3
1
1

1 2
1

1 1

1 1

1 2
1

1 7
1
1
1
1
1

1 1

1 1

1 2
1

Create variable using match function

May 13, 2014, 2:30 am

≫ Next: automated pop up message when entering certain values to notify

≪ Previous: Add contiguous cells, and put result in the top cell

$

0

0

Dear Concern

Please help me to write a code to find a match value based on four criteria between two sheets in the attached excel file to create a variable:

same year
same industry
same size (+-30% of size matching between the firms)
same NPAT/TA (-+10% of NPATTA)

If match found, then g2 cell of sample firm sheet will retrieve the value of +-10% of NPATTA variable from "all firm sheet".

Thank you in advance.

Regards
Shams

Attached Files

• Excel help_matched firm.xlsx‎ (19.4 KB) Download

automated pop up message when entering certain values to notify

May 13, 2014, 2:32 am

≫ Next: Copying Cells to new sheet

≪ Previous: Create variable using match function

$

0

0

Dbod_BUDGET_TEMPLATE_NEW_test popup.xlsmHi,

I have created a budget template.
In some instances, a discount is offered when more that x amount of products are ordered ( it varies,so I'll have to change the macro for each instance). I'd like to have a pop up box appear ( and dissapear again when pressing 'enter') that gives a notification like: a discount is applicable, please select'


my cell with entered amount is "I54", and want a message if entered above 5

I tried the below and swapped places between sentence 1 and two as it doesn't seem to recognize subname, or sub start, or it just dissapears from my macro list ( although still a module):
driving me nuts that i can't figure it out as I KNOW it's a simple mistake.. ( in the below order, it stated it expects the sub to end after sentence 1, if i remove sub popup () ( the title) ut just deletes the thing from my macro lsit,w hat is goign on!, and it just wont work)


'Sub popup()
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("I54")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
If Target.Value > 5 Then
MsgBox "a discount is applicable, please select"
End If
End Sub

can someone restore my sanity please?

thanks!

Copying Cells to new sheet

May 13, 2014, 2:37 am

≫ Next: VBA problem - Cut cells and paste relating to same name in column A

≪ Previous: automated pop up message when entering certain values to notify

$

0

0

Hi, I hope this will be a quick and easy fix. We will insert a row of values into sheet 1 starting at cell ref C13/D13 following on down the sheet. There may be 1 row, there may be up to 200 rows but will always consist of a from and a To value. I then want to transpose the first values into the sheets called DESK (1) in the boxes marked From and To. If there is a second row I need to insert a sheet, copy the layout of DESK (1), call it DESK (2) and insert values for desk 2 and so on. Lastly I need to ensure print values for each sheet are set to print one sided only. Many thanks in advance love this site!!

Attached Files

• TRADER DESK SHEETS new.xlsx‎ (22.6 KB) Download

VBA problem - Cut cells and paste relating to same name in column A

May 13, 2014, 2:45 am

≫ Next: macro to produce paramterized customized printout

≪ Previous: Copying Cells to new sheet

$

0

0

Hi,

I usually read through the forum rather than ask questions as you guys are amazing, and the tips and answers you have given have helped my improve my excel skills immensely - to the point where I've gone from a complete novice to being confident enough to attempt writing macros.

This is my first post here, and I'm afraid that there is something I have not been able to find the answer to, or figure out for myself.

My issue is this:

I have a spreadsheet that has the name of a brand in column A, the details of the brand items sold in columns B-G. In order for my vlookup calculation to work, where the brand name in cell A3 is the same as cell A2 I need to cut and paste the contents of cells B3-G3 into column A from cell H2 onwards.

I would need this to loop until there is a change in the brand name (column A), and then do the same for the next brand.

I know how to use vba to delete the empty rows (I am aware that there will still be data in column A, but can use VBA to clean up where column B us empty), but I am stuck on the meaty part!

The attachment below shows what I am trying to achieve.

Example.xlsx

Can anyone help?

Many thanks,

Curtis

---

macro to produce paramterized customized printout

May 13, 2014, 2:47 am

≫ Next: Automation error Object invoked has disconnected from its clients

≪ Previous: VBA problem - Cut cells and paste relating to same name in column A

$

0

0

Hi

I am an experienced Java-Programmer with 0 experience in excel programming (well, my last macro programming experiments date back 20 years or so ... shocking ...).

I have a reporting-sheet with weeks as columns and projects as rows. Each project has a project manager.

Once a week, project managers meet and report their projects based on this sheet. To prepare, I have to filter out my projects (rows) and disable columns of past weeks (because excel cannot print unconnected areas). Then I can print the selection.

Now I want to automate this process as follows:
- select project manager
- select a range of weeks

-> the macro will filter-out the rows and disable unneccessary columns, then print the remaining, visible cells.

As I am complete newbee I need basic advice.

My approach would be to record a macro and then manually fill in the paramters, but I am unsure how to do so, especially regarding input facilities, dialogs or similar.

Thanks in advance and cheers,

Dostl_ba!

Automation error Object invoked has disconnected from its clients

May 13, 2014, 2:51 am

≫ Next: Copy formatting

≪ Previous: macro to produce paramterized customized printout

$

0

0

Hi All,

I am no VBA expert here so go easy on me :-)

I have a series of spreadsheets that I add a line of data to every day. I recorded the simplest of VBA macros in my personal file which copies the selected line and inserts a copy into the line above on several sheets.

Sub CopyAndInsertBefore()
'
' CopyAndInsertBefore Macro
'
' Keyboard Shortcut: Ctrl+q
'
Selection.Copy
Selection.Insert Shift:=xlDown
End Sub

This is working fine on most of the spreadsheets but on one of them it works on the first tab not not on two others.

copy insert error.png

The error happens every time in the same place. Must be something specific about the file It fails in but i can't see it. The debug option tells me nothing. Any thoughts?

Bob

Copy formatting

May 13, 2014, 3:08 am

≫ Next: Form to Fill Students tests result

≪ Previous: Automation error Object invoked has disconnected from its clients

$

0

0

Hello,
I have two worksheets. both are almost identical although one has the colour red background on certain cells in the range.
How do i copy only the colours to the range on the other worksheet only?
Both ranges are identical and dynamic in size. The structure of both spreadsheets are identical.

Form to Fill Students tests result

May 13, 2014, 3:09 am

≫ Next: Run time error '91': object variable or with block variable not set

≪ Previous: Copy formatting

$

0

0

Hi everybody,

please can anyone help me to make form to search for students by "Code" or "name" and write the tests results to be shown on the cells from "B:D" & "F:H".
sheet is attached.

thanks a lot guys in advance.

Attached Files

• Contest.xlsx‎ (12.8 KB) Download

Run time error '91': object variable or with block variable not set

May 13, 2014, 3:12 am

≫ Next: Macro For Searching and Counting

≪ Previous: Form to Fill Students tests result

$

0

0

i wanted to update whole excelsheet dynamically i am stuck here

Code:

---

Dim MyConn As ADODB.Connection
Dim MyRecSet As Recordset
Dim MyRecSet1 As Recordset
Dim i, str As String, StrSQL As String, num
Dim j, temp

Set MyRecSet = MyConn.Execute("SELECT * FROM tblprod_agr_006")


For i = 0 To MyRecSet.Fields.count - 1
str = MyRecSet.Fields(i).Name
Set MyRecSet1 = New Recordset
StrSQL = "SELECT " + str + " FROM tblprod_agr_006"



On Error GoTo ErrHandler

'Retreive the records
MyRecSet1.CursorLocation = adUseClient
MyRecSet1.Open StrSQL, MyConn, adOpenStatic, adLockBatchOptimistic
num = MyRecSet1.RecordCount


j = 0


Do Until MyRecSet1.EOF
temp = MyRecSet1.Fields(0).Value

If temp = "" Then
MyRecSet1.Update
MyRecSet1.Fields(0) = ""
End If

If temp = "#" Then
MyRecSet1.Update
MyRecSet1.Fields(0) = ""
End If

If temp = "null" Then
MyRecSet1.Update
MyRecSet1.Fields(0) = ""
End If

j = j + 1

MyRecSet1.MoveNext

Loop

MyRecSet1.UpdateBatch


Next

MyConn.Close



'Exit Function

ErrHandler:
MsgBox "Sorry, an error occured. " & Err.Description, vbOKOnly

---